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

Merge branch 'development' into 20-NewStyleDislotwin

This commit is contained in:
Martin Diehl 2018-09-11 02:37:51 +02:00
parent 8b3d30fdd4 07dcdc9fc6
commit 51a6f4b990
100 changed files with 5933 additions and 28837 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
.gitlab-ci.yml
View File

@ -3,8 +3,8 @@ stages:
- prepareAll
- preprocessing
- postprocessing
- compileSpectralIntel
- compileSpectralGNU
- compilePETScIntel
- compilePETScGNU
- prepareSpectral
- spectral
- compileMarc2017
@ -29,6 +29,11 @@ before_script:
done
- source $DAMASKROOT/env/DAMASK.sh
- cd $DAMASKROOT/PRIVATE/testing
- echo Job start:" $(date)"
###################################################################################################
after_script:
- echo Job end:" $(date)"
###################################################################################################
variables:
@ -47,6 +52,7 @@ variables:
# ===============================================================================================
# ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++
IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016"
IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4"
IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017"
IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018"
GNUCompiler7_3: "Compiler/GNU/7.3"
@ -186,8 +192,8 @@ Post_ParaviewRelated:
- release
###################################################################################################
Compile_Intel:
stage: compileSpectralIntel
Compile_Spectral_Intel:
stage: compilePETScIntel
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel
- SpectralAll_compile/test.py
@ -195,9 +201,18 @@ Compile_Intel:
- master
- release
Compile_FEM_Intel:
stage: compilePETScIntel
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel
- FEM_compile/test.py
except:
- master
- release
###################################################################################################
Compile_GNU:
stage: compileSpectralGNU
Compile_Spectral_GNU:
stage: compilePETScGNU
script:
- module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU
- SpectralAll_compile/test.py
@ -205,6 +220,15 @@ Compile_GNU:
- master
- release
Compile_FEM_GNU:
stage: compilePETScGNU
script:
- module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU
- FEM_compile/test.py
except:
- master
- release
###################################################################################################
Compile_Intel_Prepare:
stage: prepareSpectral
@ -329,7 +353,7 @@ TextureComponents:
Marc_compileIfort2017:
stage: compileMarc2017
script:
- module load $IntelCompiler17_0 $MSC2017
- module load $IntelCompiler16_4 $MSC2017
- Marc_compileIfort/test.py -m 2017
except:
- master
@ -339,7 +363,7 @@ Marc_compileIfort2017:
Hex_elastic:
stage: marc
script:
- module load $IntelCompiler17_0 $MSC
- module load $IntelCompiler16_4 $MSC
- Hex_elastic/test.py
except:
- master
@ -348,7 +372,7 @@ Hex_elastic:
CubicFCC_elastic:
stage: marc
script:
- module load $IntelCompiler17_0 $MSC
- module load $IntelCompiler16_4 $MSC
- CubicFCC_elastic/test.py
except:
- master
@ -357,7 +381,7 @@ CubicFCC_elastic:
CubicBCC_elastic:
stage: marc
script:
- module load $IntelCompiler17_0 $MSC
- module load $IntelCompiler16_4 $MSC
- CubicBCC_elastic/test.py
except:
- master
@ -366,7 +390,7 @@ CubicBCC_elastic:
J2_plasticBehavior:
stage: marc
script:
- module load $IntelCompiler17_0 $MSC
- module load $IntelCompiler16_4 $MSC
- J2_plasticBehavior/test.py
except:
- master
@ -376,7 +400,7 @@ J2_plasticBehavior:
Abaqus_compile2017:
stage: compileAbaqus2017
script:
- module load $IntelCompiler16_0 $Abaqus2017
- module load $IntelCompiler16_4 $Abaqus2017
- Abaqus_compileIfort/test.py -a 2017
except:
- master
@ -392,7 +416,7 @@ SpectralExample:
AbaqusExample:
stage: example
script:
- module load $IntelCompiler16_0 $Abaqus
- module load $IntelCompiler16_4 $Abaqus
- Abaqus_example/test.py
only:
- development
@ -418,6 +442,9 @@ createTar:
script:
- cd $(mktemp -d)
- $DAMASKROOT/PRIVATE/releasing/deployMe.sh $CI_COMMIT_SHA
except:
- master
- release
###################################################################################################
AbaqusStd:

103
DAMASK_prerequisites.sh
View File

@ -12,21 +12,38 @@ echo + Send to damask@mpie.de for support
echo + view with \'cat $OUTFILE\'
echo ===========================================
function firstLevel {
echo -e '\n\n=============================================================================================='
echo $1
echo ==============================================================================================
}
function secondLevel {
echo ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
echo $1
echo ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
}
function thirdLevel {
echo -e '\n----------------------------------------------------------------------------------------------'
echo $1
echo ----------------------------------------------------------------------------------------------
}
function getDetails {
if which $1 &> /dev/null; then
echo ----------------------------------------------------------------------------------------------
echo $1:
echo ----------------------------------------------------------------------------------------------
secondLevel $1:
echo + location:
which $1
echo + $1 $2:
$1 $2
echo -e '\n'
else
echo $1 not found
fi
echo
}
# redirect STDOUT and STDERR to logfile
# https://stackoverflow.com/questions/11229385/redirect-all-output-in-a-bash-script-when-using-set-x^
exec > $OUTFILE 2>&1
@ -38,28 +55,18 @@ DAMASK_ROOT="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
echo XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
echo System report for \'$(hostname)\' created on $(date '+%Y-%m-%d %H:%M:%S') by \'$(whoami)\'
echo XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
echo
echo ==============================================================================================
echo DAMASK settings
echo ==============================================================================================
echo ----------------------------------------------------------------------------------------------
echo DAMASK_ROOT:
echo ----------------------------------------------------------------------------------------------
firstLevel "DAMASK settings"
secondLevel "DAMASK_ROOT"
echo $DAMASK_ROOT
echo
echo ----------------------------------------------------------------------------------------------
echo Version:
echo ----------------------------------------------------------------------------------------------
secondLevel "Version"
cat VERSION
echo
echo ----------------------------------------------------------------------------------------------
echo Settings in CONFIG:
echo ----------------------------------------------------------------------------------------------
secondLevel "Settings in CONFIG"
cat CONFIG
echo
echo ==============================================================================================
echo System
echo ==============================================================================================
firstLevel "System"
uname -a
echo
echo PATH: $PATH
@ -69,74 +76,52 @@ echo SHELL: $SHELL
echo PETSC_ARCH: $PETSC_ARCH
echo PETSC_DIR: $PETSC_DIR
ls $PETSC_DIR/lib
echo
echo ==============================================================================================
echo Python
echo ==============================================================================================
firstLevel "Python"
DEFAULT_PYTHON=python2.7
for executable in python python2 python3 python2.7; do
getDetails $executable '--version'
done
echo ----------------------------------------------------------------------------------------------
echo Details on $DEFAULT_PYTHON:
echo ----------------------------------------------------------------------------------------------
secondLevel "Details on $DEFAULT_PYTHON:"
echo $(ls -la $(which $DEFAULT_PYTHON))
for module in numpy scipy;do
echo -e '\n----------------------------------------------------------------------------------------------'
echo $module
echo ----------------------------------------------------------------------------------------------
thirdLevel $module
$DEFAULT_PYTHON -c "import $module; \
print('Version: {}'.format($module.__version__)); \
print('Location: {}'.format($module.__file__))"
done
echo ----------------------------------------------------------------------------------------------
echo vtk
echo ----------------------------------------------------------------------------------------------
thirdLevel vtk
$DEFAULT_PYTHON -c "import vtk; \
print('Version: {}'.format(vtk.vtkVersion.GetVTKVersion())); \
print('Location: {}'.format(vtk.__file__))"
echo ----------------------------------------------------------------------------------------------
echo h5py
echo ----------------------------------------------------------------------------------------------
thirdLevel h5py
$DEFAULT_PYTHON -c "import h5py; \
print('Version: {}'.format(h5py.version.version)); \
print('Location: {}'.format(h5py.__file__))"
echo
echo ==============================================================================================
echo GCC
echo ==============================================================================================
firstLevel "GNU Compiler Collection"
for executable in gcc g++ gfortran ;do
getDetails $executable '--version'
done
echo
echo ==============================================================================================
echo Intel Compiler Suite
echo ==============================================================================================
firstLevel "Intel Compiler Suite"
for executable in icc icpc ifort ;do
getDetails $executable '--version'
done
echo
echo ==============================================================================================
echo MPI Wrappers
echo ==============================================================================================
firstLevel "MPI Wrappers"
for executable in mpicc mpiCC mpic++ mpicpc mpicxx mpifort mpif90 mpif77; do
getDetails $executable '-show'
done
echo
echo ==============================================================================================
echo MPI Launchers
echo ==============================================================================================
firstLevel "MPI Launchers"
for executable in mpirun mpiexec; do
getDetails $executable '--version'
done
echo
echo ==============================================================================================
echo Abaqus
echo ==============================================================================================
firstLevel "Abaqus"
cd installation/mods_Abaqus # to have the right environment file
for executable in abaqus abq2016 abq2017; do
for executable in abaqus abq2017 abq2018; do
getDetails $executable 'information=all'
done
cd ../..

2
PRIVATE

@ -1 +1 @@
Subproject commit 20881ab8ebe6e64bac939ef6b2f8eb5168601a71
Subproject commit 2c40bb79f9a57d2178eb7be0e533fd5104f9f87e

2
VERSION
View File

@ -1 +1 @@
v2.0.2-226-g6ed1e316
v2.0.2-514-gbfa56e9b

2
env/DAMASK.csh vendored
View File

@ -20,6 +20,8 @@ endif
# currently, there is no information that unlimited causes problems
# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it
# more info https://jblevins.org/log/segfault
# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap
# http://superuser.com/questions/220059/what-parameters-has-ulimit
limit datasize unlimited # maximum heap size (kB)
limit stacksize unlimited # maximum stack size (kB)

2
env/DAMASK.sh vendored
View File

@ -43,6 +43,8 @@ PROCESSING=$(type -p postResults || true 2>/dev/null)
# currently, there is no information that unlimited causes problems
# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it
# more info https://jblevins.org/log/segfault
# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap
# http://superuser.com/questions/220059/what-parameters-has-ulimit
ulimit -d unlimited 2>/dev/null # maximum heap size (kB)
ulimit -s unlimited 2>/dev/null # maximum stack size (kB)

2
env/DAMASK.zsh vendored
View File

@ -34,6 +34,8 @@ PROCESSING=$(which postResults || true 2>/dev/null)
# currently, there is no information that unlimited causes problems
# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it
# more info https://jblevins.org/log/segfault
# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap
# http://superuser.com/questions/220059/what-parameters-has-ulimit
ulimit -d unlimited 2>/dev/null # maximum heap size (kB)
ulimit -s unlimited 2>/dev/null # maximum stack size (kB)

2
examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config
View File

@ -18,5 +18,5 @@ tau0_slip 405.8e6 456.7e6 # per family
tausat_slip 872.9e6 971.2e6 # per family
h0_slipslip 563.0e9
interaction_slipslip 1 1 1.4 1.4 1.4 1.4
w0_slip 2.0
a_slip 2.0
(output) totalshear

4
examples/SpectralMethod/EshelbyInclusion/material.config
View File

@ -38,7 +38,7 @@ plasticity none
[Ti matrix]
lattice_structure hex
covera_ratio 1.587
c/a 1.587
plasticity none
{config/elastic_Ti.config}
{config/thermal.config}
@ -65,7 +65,7 @@ plasticity none
[Ti inclusion]
lattice_structure hex
covera_ratio 1.587
c/a 1.587
plasticity none
{config/elastic_Ti.config}
{config/thermal.config}

52
installation/mods_MarcMentat/2016/Marc_tools/comp_damask
View File

@ -1,52 +0,0 @@
#!/bin/ksh
# 1st arg: $DIR
# 2nd arg: $DIRJOB
# 3rd arg: $user
# 4th arg: $program
DIR=$1
user=$3
program=$4
usernoext=$user
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
# add BLAS options for linking
BLAS="%BLAS%"
. $DIR/tools/include
DIRJOB=$2
cd $DIRJOB
echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
$DFORTRAN $user || \
{
echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
$DIR/lib/blkdta.o $DIR/lib/comm?.o \
${userobj-} \
$DIR/lib/srclib.a \
$MNFLIBS \
$MDUSER \
../lib/mdsrc.a \
../lib/mcvfit.a \
$STUBS \
${SOLVERLIBS} \
$TKLIBS \
$MRCLIBS \
$METISLIBS \
$BLAS \
$SYSLIBS || \
{
echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
/bin/rm $DIRJOB/*.mod

52
installation/mods_MarcMentat/2016/Marc_tools/comp_damask_h
View File

@ -1,52 +0,0 @@
#!/bin/ksh
# 1st arg: $DIR
# 2nd arg: $DIRJOB
# 3rd arg: $user
# 4th arg: $program
DIR=$1
user=$3
program=$4
usernoext=$user
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
# add BLAS options for linking
BLAS="%BLAS%"
. $DIR/tools/include
DIRJOB=$2
cd $DIRJOB
echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
$DFORTHIGH $user || \
{
echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
$DIR/lib/blkdta.o $DIR/lib/comm?.o \
${userobj-} \
$DIR/lib/srclib.a \
$MNFLIBS \
$MDUSER \
../lib/mdsrc.a \
../lib/mcvfit.a \
$STUBS \
${SOLVERLIBS} \
$TKLIBS \
$MRCLIBS \
$METISLIBS \
$BLAS \
$SYSLIBS || \
{
echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
/bin/rm $DIRJOB/*.mod

52
installation/mods_MarcMentat/2016/Marc_tools/comp_damask_l
View File

@ -1,52 +0,0 @@
#!/bin/ksh
# 1st arg: $DIR
# 2nd arg: $DIRJOB
# 3rd arg: $user
# 4th arg: $program
DIR=$1
user=$3
program=$4
usernoext=$user
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
# add BLAS options for linking
BLAS="%BLAS%"
. $DIR/tools/include
DIRJOB=$2
cd $DIRJOB
echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
$DFORTLOW $user || \
{
echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
$DIR/lib/blkdta.o $DIR/lib/comm?.o \
${userobj-} \
$DIR/lib/srclib.a \
$MNFLIBS \
$MDUSER \
../lib/mdsrc.a \
../lib/mcvfit.a \
$STUBS \
${SOLVERLIBS} \
$TKLIBS \
$MRCLIBS \
$METISLIBS \
$BLAS \
$SYSLIBS || \
{
echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
/bin/rm $DIRJOB/*.mod

4112
installation/mods_MarcMentat/2016/Marc_tools/run_damask
View File

File diff suppressed because it is too large Load Diff

4112
installation/mods_MarcMentat/2016/Marc_tools/run_damask_h
View File

File diff suppressed because it is too large Load Diff

4112
installation/mods_MarcMentat/2016/Marc_tools/run_damask_l
View File

File diff suppressed because it is too large Load Diff

8
installation/mods_MarcMentat/2016/Mentat_bin/kill7
View File

@ -1,8 +0,0 @@
#!/bin/sh
if [ "$1" = "" ]; then
echo "usage: $0 job_name"
exit 1
fi
echo STOP > $1.cnt

8
installation/mods_MarcMentat/2016/Mentat_bin/kill8
View File

@ -1,8 +0,0 @@
#!/bin/sh
if [ "$1" = "" ]; then
echo "usage: $0 job_name"
exit 1
fi
echo STOP > $1.cnt

8
installation/mods_MarcMentat/2016/Mentat_bin/kill9
View File

@ -1,8 +0,0 @@
#!/bin/sh
if [ "$1" = "" ]; then
echo "usage: $0 job_name"
exit 1
fi
echo STOP > $1.cnt

187
installation/mods_MarcMentat/2016/Mentat_bin/submit7
View File

@ -1,187 +0,0 @@
#!/bin/sh
#
# The exit status of this script is read by Mentat.
# Normal exit status is 0.
#
DIR=%INSTALLDIR%/marc%VERSION%
if test $MARCDIR1
then
DIR=$MARCDIR1
fi
if test -z "$DIR"; then
REALCOM="`ls -l $0 |awk '{ print $NF; }'`"
DIRSCRIPT=`dirname $REALCOM`
case $DIRSCRIPT in
\/*)
;;
*)
DIRSCRIPT=`pwd`/$DIRSCRIPT
;;
esac
. $DIRSCRIPT/getarch
DIR="$MENTAT_MARCDIR"
fi
SRCEXT=.f
SRCEXTC=.F
RSTEXT=.t08
PSTEXT=.t19
PSTEXTB=.t16
VWFCEXT=.vfs
slv=$1
version=$2
ndom_fea_solver=$3
ndom_preprocessor=$4
hostfile=$5
compat=$6
job=$7
srcfile=$8
srcmeth=$9
shift 9 # cannot use $10, $11, ...
restart=$1
postfile=$2
viewfactorsfile=$3
autorst=$4
copy_datfile="-ci $5"
copy_postfile="-cr $6"
scr_dir=$7
dcoup=$8
assem_recov_nthread=$9
shift 9 # cannot use $10, $11, ...
nthread=$1
nsolver=$2
mode=$3
gpu=$4
if [ "$slv" != "" -a "$slv" != "marc" ]; then
slv="-iam sfm"
else
slv=""
fi
if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then
nprocds="-nprocds $ndom_fea_solver"
else
nprocd=""
if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then
nprocd="-nprocd $ndom_preprocessor"
else
nprocd=""
fi
fi
if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then
srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"`
case "$srcmeth" in
-)
srcfile="-u $srcfile"
;;
compsave)
srcfile="-u $srcfile -save y"
;;
runsaved)
srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
else
srcfile=""
fi
if [ "$restart" != "" -a "$restart" != "-" ]; then
restart=`echo $restart | sed "s/$RSTEXT$//"`
restart="-r $restart"
else
restart=""
fi
if [ "$postfile" != "" -a "$postfile" != "-" ]; then
postfile=`echo $postfile | sed "s/$PSTEXT$//"`
postfile=`echo $postfile | sed "s/$PSTEXTB$//"`
postfile="-pid $postfile"
else
postfile=""
fi
if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then
viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"`
viewfactorsfile="-vf $viewfactorsfile"
else
viewfactorsfile=""
fi
if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then
hostfile="-ho $hostfile"
else
hostfile=""
fi
if [ "$compat" != "" -a "$compat" != "-" ]; then
compat="-co $compat"
else
compat=""
fi
if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then
scr_dir="-sd $scr_dir"
else
scr_dir=""
fi
if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then
dcoup="-dcoup $dcoup"
else
dcoup=""
fi
if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then
assem_recov_nthread="-nthread_elem $assem_recov_nthread"
else
assem_recov_nthread=""
fi
if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then
nthread="-nthread $nthread"
else
nthread=""
fi
if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then
nsolver="-nsolver $nsolver"
else
nsolver=""
fi
case "$mode" in
4) mode="-mo i4" ;;
8) mode="-mo i8" ;;
*) mode= ;;
esac
if [ "$gpu" != "" -a "$gpu" != "-" ]; then
gpu="-gpu $gpu"
else
gpu=""
fi
rm -f $job.cnt
rm -f $job.sts
rm -f $job.out
rm -f $job.log
# To prevent a mismatch with the python version used by the solver
# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH
# unset environment variables PYTHONHOME and PYTHONPATH
unset PYTHONHOME
unset PYTHONPATH
"${DIR}/tools/run_damask_h" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
sleep 1
exit 0

187
installation/mods_MarcMentat/2016/Mentat_bin/submit8
View File

@ -1,187 +0,0 @@
#!/bin/sh
#
# The exit status of this script is read by Mentat.
# Normal exit status is 0.
#
DIR=%INSTALLDIR%/marc%VERSION%
if test $MARCDIR1
then
DIR=$MARCDIR1
fi
if test -z "$DIR"; then
REALCOM="`ls -l $0 |awk '{ print $NF; }'`"
DIRSCRIPT=`dirname $REALCOM`
case $DIRSCRIPT in
\/*)
;;
*)
DIRSCRIPT=`pwd`/$DIRSCRIPT
;;
esac
. $DIRSCRIPT/getarch
DIR="$MENTAT_MARCDIR"
fi
SRCEXT=.f
SRCEXTC=.F
RSTEXT=.t08
PSTEXT=.t19
PSTEXTB=.t16
VWFCEXT=.vfs
slv=$1
version=$2
ndom_fea_solver=$3
ndom_preprocessor=$4
hostfile=$5
compat=$6
job=$7
srcfile=$8
srcmeth=$9
shift 9 # cannot use $10, $11, ...
restart=$1
postfile=$2
viewfactorsfile=$3
autorst=$4
copy_datfile="-ci $5"
copy_postfile="-cr $6"
scr_dir=$7
dcoup=$8
assem_recov_nthread=$9
shift 9 # cannot use $10, $11, ...
nthread=$1
nsolver=$2
mode=$3
gpu=$4
if [ "$slv" != "" -a "$slv" != "marc" ]; then
slv="-iam sfm"
else
slv=""
fi
if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then
nprocds="-nprocds $ndom_fea_solver"
else
nprocd=""
if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then
nprocd="-nprocd $ndom_preprocessor"
else
nprocd=""
fi
fi
if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then
srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"`
case "$srcmeth" in
-)
srcfile="-u $srcfile"
;;
compsave)
srcfile="-u $srcfile -save y"
;;
runsaved)
srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
else
srcfile=""
fi
if [ "$restart" != "" -a "$restart" != "-" ]; then
restart=`echo $restart | sed "s/$RSTEXT$//"`
restart="-r $restart"
else
restart=""
fi
if [ "$postfile" != "" -a "$postfile" != "-" ]; then
postfile=`echo $postfile | sed "s/$PSTEXT$//"`
postfile=`echo $postfile | sed "s/$PSTEXTB$//"`
postfile="-pid $postfile"
else
postfile=""
fi
if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then
viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"`
viewfactorsfile="-vf $viewfactorsfile"
else
viewfactorsfile=""
fi
if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then
hostfile="-ho $hostfile"
else
hostfile=""
fi
if [ "$compat" != "" -a "$compat" != "-" ]; then
compat="-co $compat"
else
compat=""
fi
if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then
scr_dir="-sd $scr_dir"
else
scr_dir=""
fi
if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then
dcoup="-dcoup $dcoup"
else
dcoup=""
fi
if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then
assem_recov_nthread="-nthread_elem $assem_recov_nthread"
else
assem_recov_nthread=""
fi
if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then
nthread="-nthread $nthread"
else
nthread=""
fi
if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then
nsolver="-nsolver $nsolver"
else
nsolver=""
fi
case "$mode" in
4) mode="-mo i4" ;;
8) mode="-mo i8" ;;
*) mode= ;;
esac
if [ "$gpu" != "" -a "$gpu" != "-" ]; then
gpu="-gpu $gpu"
else
gpu=""
fi
rm -f $job.cnt
rm -f $job.sts
rm -f $job.out
rm -f $job.log
# To prevent a mismatch with the python version used by the solver
# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH
# unset environment variables PYTHONHOME and PYTHONPATH
unset PYTHONHOME
unset PYTHONPATH
"${DIR}/tools/run_damask" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
sleep 1
exit 0

187
installation/mods_MarcMentat/2016/Mentat_bin/submit9
View File

@ -1,187 +0,0 @@
#!/bin/sh
#
# The exit status of this script is read by Mentat.
# Normal exit status is 0.
#
DIR=%INSTALLDIR%/marc%VERSION%
if test $MARCDIR1
then
DIR=$MARCDIR1
fi
if test -z "$DIR"; then
REALCOM="`ls -l $0 |awk '{ print $NF; }'`"
DIRSCRIPT=`dirname $REALCOM`
case $DIRSCRIPT in
\/*)
;;
*)
DIRSCRIPT=`pwd`/$DIRSCRIPT
;;
esac
. $DIRSCRIPT/getarch
DIR="$MENTAT_MARCDIR"
fi
SRCEXT=.f
SRCEXTC=.F
RSTEXT=.t08
PSTEXT=.t19
PSTEXTB=.t16
VWFCEXT=.vfs
slv=$1
version=$2
ndom_fea_solver=$3
ndom_preprocessor=$4
hostfile=$5
compat=$6
job=$7
srcfile=$8
srcmeth=$9
shift 9 # cannot use $10, $11, ...
restart=$1
postfile=$2
viewfactorsfile=$3
autorst=$4
copy_datfile="-ci $5"
copy_postfile="-cr $6"
scr_dir=$7
dcoup=$8
assem_recov_nthread=$9
shift 9 # cannot use $10, $11, ...
nthread=$1
nsolver=$2
mode=$3
gpu=$4
if [ "$slv" != "" -a "$slv" != "marc" ]; then
slv="-iam sfm"
else
slv=""
fi
if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then
nprocds="-nprocds $ndom_fea_solver"
else
nprocd=""
if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then
nprocd="-nprocd $ndom_preprocessor"
else
nprocd=""
fi
fi
if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then
srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"`
case "$srcmeth" in
-)
srcfile="-u $srcfile"
;;
compsave)
srcfile="-u $srcfile -save y"
;;
runsaved)
srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
else
srcfile=""
fi
if [ "$restart" != "" -a "$restart" != "-" ]; then
restart=`echo $restart | sed "s/$RSTEXT$//"`
restart="-r $restart"
else
restart=""
fi
if [ "$postfile" != "" -a "$postfile" != "-" ]; then
postfile=`echo $postfile | sed "s/$PSTEXT$//"`
postfile=`echo $postfile | sed "s/$PSTEXTB$//"`
postfile="-pid $postfile"
else
postfile=""
fi
if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then
viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"`
viewfactorsfile="-vf $viewfactorsfile"
else
viewfactorsfile=""
fi
if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then
hostfile="-ho $hostfile"
else
hostfile=""
fi
if [ "$compat" != "" -a "$compat" != "-" ]; then
compat="-co $compat"
else
compat=""
fi
if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then
scr_dir="-sd $scr_dir"
else
scr_dir=""
fi
if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then
dcoup="-dcoup $dcoup"
else
dcoup=""
fi
if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then
assem_recov_nthread="-nthread_elem $assem_recov_nthread"
else
assem_recov_nthread=""
fi
if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then
nthread="-nthread $nthread"
else
nthread=""
fi
if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then
nsolver="-nsolver $nsolver"
else
nsolver=""
fi
case "$mode" in
4) mode="-mo i4" ;;
8) mode="-mo i8" ;;
*) mode= ;;
esac
if [ "$gpu" != "" -a "$gpu" != "-" ]; then
gpu="-gpu $gpu"
else
gpu=""
fi
rm -f $job.cnt
rm -f $job.sts
rm -f $job.out
rm -f $job.log
# To prevent a mismatch with the python version used by the solver
# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH
# unset environment variables PYTHONHOME and PYTHONPATH
unset PYTHONHOME
unset PYTHONPATH
"${DIR}/tools/run_damask_l" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
sleep 1
exit 0

52
installation/mods_MarcMentat/2017/Marc_tools/comp_damask
View File

@ -1,52 +0,0 @@
#!/bin/ksh
# 1st arg: $DIR
# 2nd arg: $DIRJOB
# 3rd arg: $user
# 4th arg: $program
DIR=$1
user=$3
program=$4
usernoext=$user
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
# add BLAS options for linking
BLAS="%BLAS%"
. $DIR/tools/include
DIRJOB=$2
cd $DIRJOB
echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
$DFORTRAN $user || \
{
echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
$DIR/lib/blkdta.o $DIR/lib/comm?.o \
${userobj-} \
$DIR/lib/srclib.a \
$MNFLIBS \
$MDUSER \
../lib/mdsrc.a \
../lib/mcvfit.a \
$STUBS \
${SOLVERLIBS} \
$TKLIBS \
$MRCLIBS \
$METISLIBS \
$BLAS \
$SYSLIBS || \
{
echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
/bin/rm $DIRJOB/*.mod

52
installation/mods_MarcMentat/2017/Marc_tools/comp_damask_h
View File

@ -1,52 +0,0 @@
#!/bin/ksh
# 1st arg: $DIR
# 2nd arg: $DIRJOB
# 3rd arg: $user
# 4th arg: $program
DIR=$1
user=$3
program=$4
usernoext=$user
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
# add BLAS options for linking
BLAS="%BLAS%"
. $DIR/tools/include
DIRJOB=$2
cd $DIRJOB
echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
$DFORTHIGH $user || \
{
echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
$DIR/lib/blkdta.o $DIR/lib/comm?.o \
${userobj-} \
$DIR/lib/srclib.a \
$MNFLIBS \
$MDUSER \
../lib/mdsrc.a \
../lib/mcvfit.a \
$STUBS \
${SOLVERLIBS} \
$TKLIBS \
$MRCLIBS \
$METISLIBS \
$BLAS \
$SYSLIBS || \
{
echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
/bin/rm $DIRJOB/*.mod

52
installation/mods_MarcMentat/2017/Marc_tools/comp_damask_l
View File

@ -1,52 +0,0 @@
#!/bin/ksh
# 1st arg: $DIR
# 2nd arg: $DIRJOB
# 3rd arg: $user
# 4th arg: $program
DIR=$1
user=$3
program=$4
usernoext=$user
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for`
usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90`
# add BLAS options for linking
BLAS="%BLAS%"
. $DIR/tools/include
DIRJOB=$2
cd $DIRJOB
echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
$DFORTLOW $user || \
{
echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
$DIR/lib/blkdta.o $DIR/lib/comm?.o \
${userobj-} \
$DIR/lib/srclib.a \
$MNFLIBS \
$MDUSER \
../lib/mdsrc.a \
../lib/mcvfit.a \
$STUBS \
${SOLVERLIBS} \
$TKLIBS \
$MRCLIBS \
$METISLIBS \
$BLAS \
$SYSLIBS || \
{
echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
/bin/rm $DIRJOB/*.mod

4122
installation/mods_MarcMentat/2017/Marc_tools/run_damask
View File

File diff suppressed because it is too large Load Diff

4122
installation/mods_MarcMentat/2017/Marc_tools/run_damask_h
View File

File diff suppressed because it is too large Load Diff

4122
installation/mods_MarcMentat/2017/Marc_tools/run_damask_l
View File

File diff suppressed because it is too large Load Diff

8
installation/mods_MarcMentat/2017/Mentat_bin/kill7
View File

@ -1,8 +0,0 @@
#!/bin/sh
if [ "$1" = "" ]; then
echo "usage: $0 job_name"
exit 1
fi
echo STOP > $1.cnt

8
installation/mods_MarcMentat/2017/Mentat_bin/kill8
View File

@ -1,8 +0,0 @@
#!/bin/sh
if [ "$1" = "" ]; then
echo "usage: $0 job_name"
exit 1
fi
echo STOP > $1.cnt

8
installation/mods_MarcMentat/2017/Mentat_bin/kill9
View File

@ -1,8 +0,0 @@
#!/bin/sh
if [ "$1" = "" ]; then
echo "usage: $0 job_name"
exit 1
fi
echo STOP > $1.cnt

187
installation/mods_MarcMentat/2017/Mentat_bin/submit7
View File

@ -1,187 +0,0 @@
#!/bin/sh
#
# The exit status of this script is read by Mentat.
# Normal exit status is 0.
#
DIR=%INSTALLDIR%/marc%VERSION%
if test $MARCDIR1
then
DIR=$MARCDIR1
fi
if test -z "$DIR"; then
REALCOM="`ls -l $0 |awk '{ print $NF; }'`"
DIRSCRIPT=`dirname $REALCOM`
case $DIRSCRIPT in
\/*)
;;
*)
DIRSCRIPT=`pwd`/$DIRSCRIPT
;;
esac
. $DIRSCRIPT/getarch
DIR="$MENTAT_MARCDIR"
fi
SRCEXT=.f
SRCEXTC=.F
RSTEXT=.t08
PSTEXT=.t19
PSTEXTB=.t16
VWFCEXT=.vfs
slv=$1
version=$2
ndom_fea_solver=$3
ndom_preprocessor=$4
hostfile=$5
compat=$6
job=$7
srcfile=$8
srcmeth=$9
shift 9 # cannot use $10, $11, ...
restart=$1
postfile=$2
viewfactorsfile=$3
autorst=$4
copy_datfile="-ci $5"
copy_postfile="-cr $6"
scr_dir=$7
dcoup=$8
assem_recov_nthread=$9
shift 9 # cannot use $10, $11, ...
nthread=$1
nsolver=$2
mode=$3
gpu=$4
if [ "$slv" != "" -a "$slv" != "marc" ]; then
slv="-iam sfm"
else
slv=""
fi
if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then
nprocds="-nprocds $ndom_fea_solver"
else
nprocd=""
if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then
nprocd="-nprocd $ndom_preprocessor"
else
nprocd=""
fi
fi
if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then
srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"`
case "$srcmeth" in
-)
srcfile="-u $srcfile"
;;
compsave)
srcfile="-u $srcfile -save y"
;;
runsaved)
srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
else
srcfile=""
fi
if [ "$restart" != "" -a "$restart" != "-" ]; then
restart=`echo $restart | sed "s/$RSTEXT$//"`
restart="-r $restart"
else
restart=""
fi
if [ "$postfile" != "" -a "$postfile" != "-" ]; then
postfile=`echo $postfile | sed "s/$PSTEXT$//"`
postfile=`echo $postfile | sed "s/$PSTEXTB$//"`
postfile="-pid $postfile"
else
postfile=""
fi
if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then
viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"`
viewfactorsfile="-vf $viewfactorsfile"
else
viewfactorsfile=""
fi
if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then
hostfile="-ho $hostfile"
else
hostfile=""
fi
if [ "$compat" != "" -a "$compat" != "-" ]; then
compat="-co $compat"
else
compat=""
fi
if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then
scr_dir="-sd $scr_dir"
else
scr_dir=""
fi
if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then
dcoup="-dcoup $dcoup"
else
dcoup=""
fi
if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then
assem_recov_nthread="-nthread_elem $assem_recov_nthread"
else
assem_recov_nthread=""
fi
if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then
nthread="-nthread $nthread"
else
nthread=""
fi
if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then
nsolver="-nsolver $nsolver"
else
nsolver=""
fi
case "$mode" in
4) mode="-mo i4" ;;
8) mode="-mo i8" ;;
*) mode= ;;
esac
if [ "$gpu" != "" -a "$gpu" != "-" ]; then
gpu="-gpu $gpu"
else
gpu=""
fi
rm -f $job.cnt
rm -f $job.sts
rm -f $job.out
rm -f $job.log
# To prevent a mismatch with the python version used by the solver
# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH
# unset environment variables PYTHONHOME and PYTHONPATH
unset PYTHONHOME
unset PYTHONPATH
"${DIR}/tools/run_damask_h" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
sleep 1
exit 0

187
installation/mods_MarcMentat/2017/Mentat_bin/submit8
View File

@ -1,187 +0,0 @@
#!/bin/sh
#
# The exit status of this script is read by Mentat.
# Normal exit status is 0.
#
DIR=%INSTALLDIR%/marc%VERSION%
if test $MARCDIR1
then
DIR=$MARCDIR1
fi
if test -z "$DIR"; then
REALCOM="`ls -l $0 |awk '{ print $NF; }'`"
DIRSCRIPT=`dirname $REALCOM`
case $DIRSCRIPT in
\/*)
;;
*)
DIRSCRIPT=`pwd`/$DIRSCRIPT
;;
esac
. $DIRSCRIPT/getarch
DIR="$MENTAT_MARCDIR"
fi
SRCEXT=.f
SRCEXTC=.F
RSTEXT=.t08
PSTEXT=.t19
PSTEXTB=.t16
VWFCEXT=.vfs
slv=$1
version=$2
ndom_fea_solver=$3
ndom_preprocessor=$4
hostfile=$5
compat=$6
job=$7
srcfile=$8
srcmeth=$9
shift 9 # cannot use $10, $11, ...
restart=$1
postfile=$2
viewfactorsfile=$3
autorst=$4
copy_datfile="-ci $5"
copy_postfile="-cr $6"
scr_dir=$7
dcoup=$8
assem_recov_nthread=$9
shift 9 # cannot use $10, $11, ...
nthread=$1
nsolver=$2
mode=$3
gpu=$4
if [ "$slv" != "" -a "$slv" != "marc" ]; then
slv="-iam sfm"
else
slv=""
fi
if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then
nprocds="-nprocds $ndom_fea_solver"
else
nprocd=""
if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then
nprocd="-nprocd $ndom_preprocessor"
else
nprocd=""
fi
fi
if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then
srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"`
case "$srcmeth" in
-)
srcfile="-u $srcfile"
;;
compsave)
srcfile="-u $srcfile -save y"
;;
runsaved)
srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
else
srcfile=""
fi
if [ "$restart" != "" -a "$restart" != "-" ]; then
restart=`echo $restart | sed "s/$RSTEXT$//"`
restart="-r $restart"
else
restart=""
fi
if [ "$postfile" != "" -a "$postfile" != "-" ]; then
postfile=`echo $postfile | sed "s/$PSTEXT$//"`
postfile=`echo $postfile | sed "s/$PSTEXTB$//"`
postfile="-pid $postfile"
else
postfile=""
fi
if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then
viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"`
viewfactorsfile="-vf $viewfactorsfile"
else
viewfactorsfile=""
fi
if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then
hostfile="-ho $hostfile"
else
hostfile=""
fi
if [ "$compat" != "" -a "$compat" != "-" ]; then
compat="-co $compat"
else
compat=""
fi
if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then
scr_dir="-sd $scr_dir"
else
scr_dir=""
fi
if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then
dcoup="-dcoup $dcoup"
else
dcoup=""
fi
if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then
assem_recov_nthread="-nthread_elem $assem_recov_nthread"
else
assem_recov_nthread=""
fi
if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then
nthread="-nthread $nthread"
else
nthread=""
fi
if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then
nsolver="-nsolver $nsolver"
else
nsolver=""
fi
case "$mode" in
4) mode="-mo i4" ;;
8) mode="-mo i8" ;;
*) mode= ;;
esac
if [ "$gpu" != "" -a "$gpu" != "-" ]; then
gpu="-gpu $gpu"
else
gpu=""
fi
rm -f $job.cnt
rm -f $job.sts
rm -f $job.out
rm -f $job.log
# To prevent a mismatch with the python version used by the solver
# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH
# unset environment variables PYTHONHOME and PYTHONPATH
unset PYTHONHOME
unset PYTHONPATH
"${DIR}/tools/run_damask" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
sleep 1
exit 0

187
installation/mods_MarcMentat/2017/Mentat_bin/submit9
View File

@ -1,187 +0,0 @@
#!/bin/sh
#
# The exit status of this script is read by Mentat.
# Normal exit status is 0.
#
DIR=%INSTALLDIR%/marc%VERSION%
if test $MARCDIR1
then
DIR=$MARCDIR1
fi
if test -z "$DIR"; then
REALCOM="`ls -l $0 |awk '{ print $NF; }'`"
DIRSCRIPT=`dirname $REALCOM`
case $DIRSCRIPT in
\/*)
;;
*)
DIRSCRIPT=`pwd`/$DIRSCRIPT
;;
esac
. $DIRSCRIPT/getarch
DIR="$MENTAT_MARCDIR"
fi
SRCEXT=.f
SRCEXTC=.F
RSTEXT=.t08
PSTEXT=.t19
PSTEXTB=.t16
VWFCEXT=.vfs
slv=$1
version=$2
ndom_fea_solver=$3
ndom_preprocessor=$4
hostfile=$5
compat=$6
job=$7
srcfile=$8
srcmeth=$9
shift 9 # cannot use $10, $11, ...
restart=$1
postfile=$2
viewfactorsfile=$3
autorst=$4
copy_datfile="-ci $5"
copy_postfile="-cr $6"
scr_dir=$7
dcoup=$8
assem_recov_nthread=$9
shift 9 # cannot use $10, $11, ...
nthread=$1
nsolver=$2
mode=$3
gpu=$4
if [ "$slv" != "" -a "$slv" != "marc" ]; then
slv="-iam sfm"
else
slv=""
fi
if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then
nprocds="-nprocds $ndom_fea_solver"
else
nprocd=""
if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then
nprocd="-nprocd $ndom_preprocessor"
else
nprocd=""
fi
fi
if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then
srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"`
case "$srcmeth" in
-)
srcfile="-u $srcfile"
;;
compsave)
srcfile="-u $srcfile -save y"
;;
runsaved)
srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
else
srcfile=""
fi
if [ "$restart" != "" -a "$restart" != "-" ]; then
restart=`echo $restart | sed "s/$RSTEXT$//"`
restart="-r $restart"
else
restart=""
fi
if [ "$postfile" != "" -a "$postfile" != "-" ]; then
postfile=`echo $postfile | sed "s/$PSTEXT$//"`
postfile=`echo $postfile | sed "s/$PSTEXTB$//"`
postfile="-pid $postfile"
else
postfile=""
fi
if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then
viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"`
viewfactorsfile="-vf $viewfactorsfile"
else
viewfactorsfile=""
fi
if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then
hostfile="-ho $hostfile"
else
hostfile=""
fi
if [ "$compat" != "" -a "$compat" != "-" ]; then
compat="-co $compat"
else
compat=""
fi
if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then
scr_dir="-sd $scr_dir"
else
scr_dir=""
fi
if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then
dcoup="-dcoup $dcoup"
else
dcoup=""
fi
if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then
assem_recov_nthread="-nthread_elem $assem_recov_nthread"
else
assem_recov_nthread=""
fi
if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then
nthread="-nthread $nthread"
else
nthread=""
fi
if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then
nsolver="-nsolver $nsolver"
else
nsolver=""
fi
case "$mode" in
4) mode="-mo i4" ;;
8) mode="-mo i8" ;;
*) mode= ;;
esac
if [ "$gpu" != "" -a "$gpu" != "-" ]; then
gpu="-gpu $gpu"
else
gpu=""
fi
rm -f $job.cnt
rm -f $job.sts
rm -f $job.out
rm -f $job.log
# To prevent a mismatch with the python version used by the solver
# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH
# unset environment variables PYTHONHOME and PYTHONPATH
unset PYTHONHOME
unset PYTHONPATH
"${DIR}/tools/run_damask_l" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
sleep 1
exit 0

25
installation/mods_MarcMentat/apply_DAMASK_modifications.sh
View File

@ -58,15 +58,9 @@ echo "Editor: $EDITOR"
echo ''
echo 'adapting Marc tools...'
theDIR=$INSTALLDIR/marc$VERSION/tools
for filename in 'comp_damask' \
'comp_damask_l' \
'comp_damask_h' \
'comp_damask_mp' \
for filename in 'comp_damask_mp' \
'comp_damask_lmp' \
'comp_damask_hmp' \
'run_damask' \
'run_damask_l' \
'run_damask_h' \
'run_damask_mp' \
'run_damask_lmp' \
'run_damask_hmp' \
@ -85,15 +79,9 @@ for filename in 'edit_window' \
'submit4' \
'submit5' \
'submit6' \
'submit7' \
'submit8' \
'submit9' \
'kill4' \
'kill5' \
'kill6' \
'kill7' \
'kill8' \
'kill9'; do
'kill6'; do
cp $SCRIPTLOCATION/$VERSION/Mentat_bin/$filename $theDIR
echo $theDIR/$filename | xargs perl -pi -e "s:%INSTALLDIR%:${INSTALLDIR}:g"
echo $theDIR/$filename | xargs perl -pi -e "s:%VERSION%:${VERSION}:g"
@ -122,8 +110,8 @@ echo ''
echo 'setting file access rights...'
for filename in marc$VERSION/tools/run_damask* \
marc$VERSION/tools/comp_damask* \
mentat$VERSION/bin/submit{4..9} \
mentat$VERSION/bin/kill{4..9} ; do
mentat$VERSION/bin/submit{4..6} \
mentat$VERSION/bin/kill{4..6} ; do
chmod 755 $INSTALLDIR/${filename}
done
@ -142,10 +130,7 @@ if [ -d "$BIN_DIR" ]; then
echo 'creating symlinks ...'
echo''
theDIR=$INSTALLDIR/marc$VERSION/tools
for filename in 'run_damask' \
'run_damask_l' \
'run_damask_h' \
'run_damask_mp' \
for filename in 'run_damask_mp' \
'run_damask_lmp' \
'run_damask_hmp'; do
echo ${filename:4}$VERSION

12
installation/mods_MarcMentat/installation.txt
View File

@ -21,16 +21,10 @@ The structure of this directory should be (VERSION = 20XX or 20XX.Y)
./installation.txt this text
./apply_MPIE_modifications script file to apply modifications to the installation
./VERSION/Marc_tools/comp_user.original original file from installation
./VERSION/Marc_tools/comp_damask modified version using -O1 optimization
./VERSION/Marc_tools/comp_damask_l modified version using -O0 optimization
./VERSION/Marc_tools/comp_damask_h modified version using -O2 optimization
./VERSION/Marc_tools/comp_damask_mp modified version using -O1 optimization and OpenMP
./VERSION/Marc_tools/comp_damask_lmp modified version using -O0 optimization and OpenMP
./VERSION/Marc_tools/comp_damask_hmp modified version using -O2 optimization and OpenMP
./VERSION/Marc_tools/run_marc.original original file from installation
./VERSION/Marc_tools/run_damask modified version using -O1 optimization
./VERSION/Marc_tools/run_damask_l modified version using -O0 optimization
./VERSION/Marc_tools/run_damask_h modified version using -O2 optimization
./VERSION/Marc_tools/run_damask_mp modified version using -O1 optimization and OpenMP
./VERSION/Marc_tools/run_damask_lmp modified version using -O0 optimization and OpenMP
./VERSION/Marc_tools/run_damask_hmp modified version using -O2 optimization and OpenMP
@ -42,14 +36,8 @@ The structure of this directory should be (VERSION = 20XX or 20XX.Y)
./VERSION/Mentat_bin/submit4 modified version of original calling run_h_marc
./VERSION/Mentat_bin/submit5 modified version of original calling run_marc
./VERSION/Mentat_bin/submit6 modified version of original calling run_l_marc
./VERSION/Mentat_bin/submit7 modified version of original calling run_hmp_marc
./VERSION/Mentat_bin/submit8 modified version of original calling run_mp_marc
./VERSION/Mentat_bin/submit9 modified version of original calling run_lmp_marc
./VERSION/Mentat_bin/kill4 kill file for submit4, identical to original kill1
./VERSION/Mentat_bin/kill5 kill file for submit5, identical to original kill1
./VERSION/Mentat_bin/kill6 kill file for submit6, identical to original kill1
./VERSION/Mentat_bin/kill7 kill file for submit7, identical to original kill1
./VERSION/Mentat_bin/kill8 kill file for submit8, identical to original kill1
./VERSION/Mentat_bin/kill9 kill file for submit9, identical to original kill1
./VERSION/Mentat_menus/job_run.ms.original original file from installation
./VERSION/Mentat_menus/job_run.ms modified version adding DAMASK menu to run menu

8
installation/patch/python2to3.sh Executable file
View File

@ -0,0 +1,8 @@
#! /usr/bin/env bash
if [ $1x != 3to2x ]; then
echo 'python2.7 to python'
find . -name '*.py' | xargs sed -i 's/usr\/bin\/env python2.7/usr\/bin\/env python/g'
else
echo 'python to python2.7'
find . -name '*.py' | xargs sed -i 's/usr\/bin\/env python/usr\/bin\/env python2.7/g'
fi

2
lib/damask/__init__.py
View File

@ -6,6 +6,8 @@ import os
with open(os.path.join(os.path.dirname(__file__),'../../VERSION')) as f:
version = f.readline()[:-1]
name = 'damask'
from .environment import Environment # noqa
from .asciitable import ASCIItable # noqa

11
lib/damask/config/material.py
View File

@ -279,3 +279,14 @@ class Material():
print('Length of value was changed from %i to %i!'%(oldlen,newlen))
def add_value(self, part=None,
section=None,
key=None,
value=None):
if not isinstance(value,list):
if not isinstance(value,str):
value = '%s'%value
value = [value]
print('adding %s:%s:%s with value %s '%(part.lower(),section.lower(),key.lower(),value))
self.data[part.lower()][section.lower()][key.lower()] = value
self.data[part.lower()][section.lower()]['__order__'] += [key.lower()]

22
lib/damask/util.py
View File

@ -36,8 +36,8 @@ class bcolors:
def srepr(arg,glue = '\n'):
"""Joins arguments as individual lines"""
if (not hasattr(arg, "strip") and
hasattr(arg, "__getitem__") or
hasattr(arg, "__iter__")):
(hasattr(arg, "__getitem__") or
hasattr(arg, "__iter__"))):
return glue.join(str(x) for x in arg)
return arg if isinstance(arg,str) else repr(arg)
@ -59,9 +59,9 @@ def report_geom(info,
what = ['grid','size','origin','homogenization','microstructures']):
"""Reports (selected) geometry information"""
output = {
'grid' : 'grid a b c: {}'.format(' x '.join(map(str,info['grid' ]))),
'size' : 'size x y z: {}'.format(' x '.join(map(str,info['size' ]))),
'origin' : 'origin x y z: {}'.format(' : '.join(map(str,info['origin']))),
'grid' : 'grid a b c: {}'.format(' x '.join(list(map(str,info['grid' ])))),
'size' : 'size x y z: {}'.format(' x '.join(list(map(str,info['size' ])))),
'origin' : 'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))),
'homogenization' : 'homogenization: {}'.format(info['homogenization']),
'microstructures' : 'microstructures: {}'.format(info['microstructures']),
}
@ -93,8 +93,10 @@ def execute(cmd,
stdout = subprocess.PIPE,
stderr = subprocess.PIPE,
stdin = subprocess.PIPE)
out,error = [i.replace(b"\x08",b"") for i in (process.communicate() if streamIn is None
else process.communicate(streamIn.read()))]
out,error = [i for i in (process.communicate() if streamIn is None
else process.communicate(streamIn.read().encode('utf-8')))]
out = out.decode('utf-8').replace('\x08','')
error = error.decode('utf-8').replace('\x08','')
os.chdir(initialPath)
if process.returncode != 0: raise RuntimeError('{} failed with returncode {}'.format(cmd,process.returncode))
return out,error
@ -103,9 +105,9 @@ def coordGridAndSize(coordinates):
"""Determines grid count and overall physical size along each dimension of an ordered array of coordinates"""
dim = coordinates.shape[1]
coords = [np.unique(coordinates[:,i]) for i in range(dim)]
mincorner = np.array(map(min,coords))
maxcorner = np.array(map(max,coords))
grid = np.array(map(len,coords),'i')
mincorner = np.array(list(map(min,coords)))
maxcorner = np.array(list(map(max,coords)))
grid = np.array(list(map(len,coords)),'i')
size = grid/np.maximum(np.ones(dim,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1)
size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 equal to smallest among other ones
return grid,size

4
processing/post/addCauchy.py
View File

@ -75,8 +75,8 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
F = np.array(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9]),'d').reshape(3,3)
P = np.array(map(float,table.data[column[options.stress ]:column[options.stress ]+9]),'d').reshape(3,3)
F = np.array(list(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9])),'d').reshape(3,3)
P = np.array(list(map(float,table.data[column[options.stress ]:column[options.stress ]+9])),'d').reshape(3,3)
table.data_append(list(1.0/np.linalg.det(F)*np.dot(P,F.T).reshape(9))) # [Cauchy] = (1/det(F)) * [P].[F_transpose]
outputAlive = table.data_write() # output processed line

9
processing/post/addCompatibilityMismatch.py
View File

@ -282,19 +282,12 @@ for name in filenames:
table.data_readArray([options.defgrad,options.pos])
table.data_rewind()
if len(table.data.shape) < 2: table.data.shape += (1,) # expand to 2D shape
if table.data[:,9:].shape[1] < 3:
table.data = np.hstack((table.data,
np.zeros((table.data.shape[0],
3-table.data[:,9:].shape[1]),dtype='f'))) # fill coords up to 3D with zeros
coords = [np.unique(table.data[:,9+i]) for i in range(3)]
mincorner = np.array(map(min,coords))
maxcorner = np.array(map(max,coords))
grid = np.array(map(len,coords),'i')
size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1)
size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings
grid,size = damask.util.coordGridAndSize(table.data[:,9:12])
N = grid.prod()
if N != len(table.data): errors.append('data count {} does not match grid {}x{}x{}.'.format(N,*grid))

1
processing/post/addCurl.py
View File

@ -138,7 +138,6 @@ for name in filenames:
# --------------- figure out size and grid ---------------------------------------------------------
table.data_readArray()
grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)])
# ------------------------------------------ process value field -----------------------------------

7
processing/post/addDeterminant.py
View File

@ -58,7 +58,7 @@ for name in filenames:
errors = []
remarks = []
for type, data in items.iteritems():
for type, data in items.items():
for what in data['labels']:
dim = table.label_dimension(what)
if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type))
@ -81,10 +81,9 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
for type, data in items.iteritems():
for type, data in items.items():
for column in data['column']:
table.data_append(determinant(map(float,table.data[column:
column+data['dim']])))
table.data_append(determinant(list(map(float,table.data[column: column+data['dim']]))))
outputAlive = table.data_write() # output processed line
# ------------------------------------------ output finalization -----------------------------------

10
processing/post/addDeviator.py
View File

@ -66,7 +66,7 @@ for name in filenames:
remarks = []
column = {}
for type, data in items.iteritems():
for type, data in items.items():
for what in data['labels']:
dim = table.label_dimension(what)
if dim != data['dim']: remarks.append('column {} is not a {}.'.format(what,type))
@ -83,7 +83,7 @@ for name in filenames:
# ------------------------------------------ assemble header --------------------------------------
table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:]))
for type, data in items.iteritems():
for type, data in items.items():
for label in data['active']:
table.labels_append(['{}_dev({})'.format(i+1,label) for i in range(data['dim'])] + \
(['sph({})'.format(label)] if options.spherical else [])) # extend ASCII header with new labels
@ -93,10 +93,10 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
for type, data in items.iteritems():
for type, data in items.items():
for column in data['column']:
table.data_append(deviator(map(float,table.data[column:
column+data['dim']]),options.spherical))
table.data_append(deviator(list(map(float,table.data[column:
column+data['dim']])),options.spherical))
outputAlive = table.data_write() # output processed line
# ------------------------------------------ output finalization -----------------------------------

8
processing/post/addDisplacement.py
View File

@ -168,13 +168,7 @@ for name in filenames:
np.zeros((table.data.shape[0],
3-table.data[:,9:].shape[1]),dtype='f'))) # fill coords up to 3D with zeros
coords = [np.unique(table.data[:,9+i]) for i in range(3)]
mincorner = np.array(map(min,coords))
maxcorner = np.array(map(max,coords))
grid = np.array(map(len,coords),'i')
size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1)
size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings
grid,size = damask.util.coordGridAndSize(table.data[:,9:12])
N = grid.prod()
if N != len(table.data): errors.append('data count {} does not match grid {}x{}x{}.'.format(N,*grid))

2
processing/post/addEhkl.py
View File

@ -88,7 +88,7 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
for column in columns:
table.data_append(E_hkl(map(float,table.data[column:column+3]),options.hkl))
table.data_append(E_hkl(list(map(float,table.data[column:column+3])),options.hkl))
outputAlive = table.data_write() # output processed line
# ------------------------------------------ output finalization -----------------------------------

12
processing/post/addEuclideanDistance.py
View File

@ -102,7 +102,7 @@ parser.add_option('-t',
help = 'feature type {{{}}} '.format(', '.join(map(lambda x:'/'.join(x['names']),features))) )
parser.add_option('-n',
'--neighborhood',
dest = 'neighborhood', choices = neighborhoods.keys(), metavar = 'string',
dest = 'neighborhood', choices = list(neighborhoods.keys()), metavar = 'string',
help = 'neighborhood type [neumann] {{{}}}'.format(', '.join(neighborhoods.keys())))
parser.add_option('-s',
'--scale',
@ -151,10 +151,8 @@ for name in filenames:
remarks = []
column = {}
coordDim = table.label_dimension(options.pos)
if not 3 >= coordDim >= 1:
if not 3 >= table.label_dimension(options.pos) >= 1:
errors.append('coordinates "{}" need to have one, two, or three dimensions.'.format(options.pos))
else: coordCol = table.label_index(options.pos)
if table.label_dimension(options.id) != 1: errors.append('grain identifier {} not found.'.format(options.id))
else: idCol = table.label_index(options.id)
@ -178,11 +176,7 @@ for name in filenames:
table.data_readArray()
coords = [np.unique(table.data[:,coordCol+i]) for i in range(coordDim)]
mincorner = np.array(map(min,coords))
maxcorner = np.array(map(max,coords))
grid = np.array(map(len,coords)+[1]*(3-len(coords)),'i')
grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)])
N = grid.prod()
if N != len(table.data): errors.append('data count {} does not match grid {}.'.format(N,'x'.join(map(str,grid))))

6
processing/post/addGaussian.py
View File

@ -83,7 +83,7 @@ for name in filenames:
if table.label_dimension(options.pos) != 3: errors.append('coordinates {} are not a vector.'.format(options.pos))
else: colCoord = table.label_index(options.pos)
for type, data in items.iteritems():
for type, data in items.items():
for what in (data['labels'] if data['labels'] is not None else []):
dim = table.label_dimension(what)
if dim != data['dim']: remarks.append('column {} is not a {}.'.format(what,type))
@ -100,7 +100,7 @@ for name in filenames:
# ------------------------------------------ assemble header --------------------------------------
table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:]))
for type, data in items.iteritems():
for type, data in items.items():
for label in data['active']:
table.labels_append(['Gauss{}({})'.format(options.sigma,label)]) # extend ASCII header with new labels
table.head_write()
@ -114,7 +114,7 @@ for name in filenames:
# ------------------------------------------ process value field -----------------------------------
stack = [table.data]
for type, data in items.iteritems():
for type, data in items.items():
for i,label in enumerate(data['active']):
stack.append(ndimage.filters.gaussian_filter(table.data[:,data['column'][i]],
options.sigma,options.order,

10
processing/post/addIPFcolor.py
View File

@ -116,18 +116,18 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
if inputtype == 'eulers':
o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians,
o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians,
symmetry = options.symmetry).reduced()
elif inputtype == 'matrix':
o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose(),
o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose(),
symmetry = options.symmetry).reduced()
elif inputtype == 'frame':
o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \
o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \
table.data[column[1]:column[1]+3] + \
table.data[column[2]:column[2]+3])).reshape(3,3),
table.data[column[2]:column[2]+3]))).reshape(3,3),
symmetry = options.symmetry).reduced()
elif inputtype == 'quaternion':
o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])),
o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))),
symmetry = options.symmetry).reduced()
table.data_append(o.IPFcolor(pole))

4
processing/post/addMises.py
View File

@ -70,7 +70,7 @@ for name in filenames:
errors = []
remarks = []
for type, data in items.iteritems():
for type, data in items.items():
for what in data['labels']:
dim = table.label_dimension(what)
if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type))
@ -94,7 +94,7 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
for type, data in items.iteritems():
for type, data in items.items():
for column in data['column']:
table.data_append(Mises(type,
np.array(table.data[column:column+data['dim']],'d').reshape(data['shape'])))

14
processing/post/addOrientations.py
View File

@ -80,7 +80,7 @@ parser.set_defaults(output = [],
(options, filenames) = parser.parse_args()
options.output = map(lambda x: x.lower(), options.output)
options.output = list(map(lambda x: x.lower(), options.output))
if options.output == [] or (not set(options.output).issubset(set(outputChoices))):
parser.error('output must be chosen from {}.'.format(', '.join(outputChoices)))
@ -147,21 +147,21 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
if inputtype == 'eulers':
o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians,
o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians,
symmetry = options.symmetry).reduced()
elif inputtype == 'rodrigues':
o = damask.Orientation(Rodrigues= np.array(map(float,table.data[column:column+3])),
o = damask.Orientation(Rodrigues= np.array(list(map(float,table.data[column:column+3]))),
symmetry = options.symmetry).reduced()
elif inputtype == 'matrix':
o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose(),
o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose(),
symmetry = options.symmetry).reduced()
elif inputtype == 'frame':
o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \
o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \
table.data[column[1]:column[1]+3] + \
table.data[column[2]:column[2]+3])).reshape(3,3),
table.data[column[2]:column[2]+3]))).reshape(3,3),
symmetry = options.symmetry).reduced()
elif inputtype == 'quaternion':
o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])),
o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))),
symmetry = options.symmetry).reduced()
o.quaternion = r*o.quaternion*R # apply additional lab and crystal frame rotations

4
processing/post/addPK2.py
View File

@ -75,8 +75,8 @@ for name in filenames:
# ------------------------------------------ process data ------------------------------------------
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
F = np.array(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9]),'d').reshape(3,3)
P = np.array(map(float,table.data[column[options.stress ]:column[options.stress ]+9]),'d').reshape(3,3)
F = np.array(list(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9])),'d').reshape(3,3)
P = np.array(list(map(float,table.data[column[options.stress ]:column[options.stress ]+9])),'d').reshape(3,3)
table.data_append(list(np.dot(np.linalg.inv(F),P).reshape(9))) # [S] =[P].[F-1]
outputAlive = table.data_write() # output processed line

10
processing/post/addPole.py
View File

@ -120,15 +120,15 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
if inputtype == 'eulers':
o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians)
o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians)
elif inputtype == 'matrix':
o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose())
o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose())
elif inputtype == 'frame':
o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \
o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \
table.data[column[1]:column[1]+3] + \
table.data[column[2]:column[2]+3])).reshape(3,3))
table.data[column[2]:column[2]+3]))).reshape(3,3))
elif inputtype == 'quaternion':
o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])))
o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))))
rotatedPole = o.quaternion*pole # rotate pole according to crystal orientation
(x,y) = rotatedPole[0:2]/(1.+abs(pole[2])) # stereographic projection

10
processing/post/addSchmidfactors.py
View File

@ -252,15 +252,15 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
if inputtype == 'eulers':
o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians,)
o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians,)
elif inputtype == 'matrix':
o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose(),)
o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose(),)
elif inputtype == 'frame':
o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \
o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \
table.data[column[1]:column[1]+3] + \
table.data[column[2]:column[2]+3])).reshape(3,3),)
table.data[column[2]:column[2]+3]))).reshape(3,3),)
elif inputtype == 'quaternion':
o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])),)
o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))),)
rotForce = o.quaternion.conjugated() * force
rotNormal = o.quaternion.conjugated() * normal

6
processing/post/addSpectralDecomposition.py
View File

@ -58,7 +58,7 @@ for name in filenames:
errors = []
remarks = []
for type, data in items.iteritems():
for type, data in items.items():
for what in data['labels']:
dim = table.label_dimension(what)
if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type))
@ -84,9 +84,9 @@ for name in filenames:
outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table
for type, data in items.iteritems():
for type, data in items.items():
for column in data['column']:
(u,v) = np.linalg.eigh(np.array(map(float,table.data[column:column+data['dim']])).reshape(data['shape']))
(u,v) = np.linalg.eigh(np.array(list(map(float,table.data[column:column+data['dim']]))).reshape(data['shape']))
if options.rh and np.dot(np.cross(v[:,0], v[:,1]), v[:,2]) < 0.0 : v[:, 2] *= -1.0 # ensure right-handed eigenvector basis
table.data_append(list(u)) # vector of max,mid,min eigval
table.data_append(list(v.transpose().reshape(data['dim']))) # 3x3=9 combo vector of max,mid,min eigvec coordinates

4
processing/post/addStrainTensors.py
View File

@ -101,7 +101,7 @@ for name in filenames:
errors = []
remarks = []
for type, data in items.iteritems():
for type, data in items.items():
for what in data['labels']:
dim = table.label_dimension(what)
if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type))
@ -132,7 +132,7 @@ for name in filenames:
while outputAlive and table.data_read(): # read next data line of ASCII table
for column in items['tensor']['column']: # loop over all requested defgrads
F = np.array(map(float,table.data[column:column+items['tensor']['dim']]),'d').reshape(items['tensor']['shape'])
F = np.array(list(map(float,table.data[column:column+items['tensor']['dim']])),'d').reshape(items['tensor']['shape'])
(U,S,Vh) = np.linalg.svd(F) # singular value decomposition
R = np.dot(U,Vh) # rotation of polar decomposition
stretch['U'] = np.dot(np.linalg.inv(R),F) # F = RU

13
processing/post/averageDown.py
View File

@ -76,7 +76,6 @@ for name in filenames:
remarks = []
if table.label_dimension(options.pos) != 3: errors.append('coordinates {} are not a vector.'.format(options.pos))
else: colCoord = table.label_index(options.pos)
if remarks != []: damask.util.croak(remarks)
if errors != []:
@ -94,14 +93,7 @@ for name in filenames:
table.data_readArray()
if (any(options.grid) == 0 or any(options.size) == 0.0):
coords = [np.unique(table.data[:,colCoord+i]) for i in range(3)]
mincorner = np.array(map(min,coords))
maxcorner = np.array(map(max,coords))
grid = np.array(map(len,coords),'i')
size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1)
size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings
delta = size/np.maximum(np.ones(3,'d'), grid)
origin = mincorner - 0.5*delta # shift from cell center to corner
grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)])
else:
grid = np.array(options.grid,'i')
@ -129,7 +121,6 @@ for name in filenames:
#--- generate grid --------------------------------------------------------------------------------
if colCoord:
x = (0.5 + shift[0] + np.arange(packedGrid[0],dtype=float))/packedGrid[0]*size[0] + origin[0]
y = (0.5 + shift[1] + np.arange(packedGrid[1],dtype=float))/packedGrid[1]*size[1] + origin[1]
z = (0.5 + shift[2] + np.arange(packedGrid[2],dtype=float))/packedGrid[2]*size[2] + origin[2]
@ -138,7 +129,7 @@ for name in filenames:
yy = np.tile(np.repeat(y,packedGrid[0] ),packedGrid[2])
zz = np.repeat(z,packedGrid[0]*packedGrid[1])
table.data[:,colCoord:colCoord+3] = np.squeeze(np.dstack((xx,yy,zz)))
table.data[:,table.label_indexragen(options.pos)] = np.squeeze(np.dstack((xx,yy,zz)))
# ------------------------------------------ output result -----------------------------------------

10
processing/post/blowUp.py
View File

@ -64,7 +64,6 @@ for name in filenames:
remarks = []
if table.label_dimension(options.pos) != 3: errors.append('coordinates "{}" are not a vector.'.format(options.pos))
else: colCoord = table.label_index(options.pos)
colElem = table.label_index('elem')
@ -79,12 +78,7 @@ for name in filenames:
table.data_readArray(options.pos)
table.data_rewind()
coords = [np.unique(table.data[:,i]) for i in range(3)]
mincorner = np.array(map(min,coords))
maxcorner = np.array(map(max,coords))
grid = np.array(map(len,coords),'i')
size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1)
size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings
grid,size = damask.util.coordGridAndSize(table.data)
packing = np.array(options.packing,'i')
outSize = grid*packing
@ -113,7 +107,7 @@ for name in filenames:
for c in range(outSize[2]):
for b in range(outSize[1]):
for a in range(outSize[0]):
data[a,b,c,colCoord:colCoord+3] = [a+0.5,b+0.5,c+0.5]*elementSize
data[a,b,c,table.label_indexrange(options.pos)] = [a+0.5,b+0.5,c+0.5]*elementSize
if colElem != -1: data[a,b,c,colElem] = elem
table.data = data[a,b,c,:].tolist()
outputAlive = table.data_write() # output processed line

6
processing/post/rotateData.py
View File

@ -73,7 +73,7 @@ for name in filenames:
remarks = []
column = {}
for type, data in items.iteritems():
for type, data in items.items():
for what in data['labels']:
dim = table.label_dimension(what)
if dim != data['dim']: remarks.append('column {} is not a {}.'.format(what,type))
@ -100,13 +100,13 @@ for name in filenames:
for column in items[datatype]['column']: # loop over all requested labels
table.data[column:column+items[datatype]['dim']] = \
q * np.array(map(float,table.data[column:column+items[datatype]['dim']]))
q * np.array(list(map(float,table.data[column:column+items[datatype]['dim']])))
datatype = 'tensor'
for column in items[datatype]['column']: # loop over all requested labels
table.data[column:column+items[datatype]['dim']] = \
np.dot(R,np.dot(np.array(map(float,table.data[column:column+items[datatype]['dim']])).\
np.dot(R,np.dot(np.array(list(map(float,table.data[column:column+items[datatype]['dim']]))).\
reshape(items[datatype]['shape']),R.transpose())).reshape(items[datatype]['dim'])
outputAlive = table.data_write() # output processed line

2
processing/post/vtk2ang.py
View File

@ -421,8 +421,6 @@ for filename in filenames:
meshActor.GetProperty().SetOpacity(0.2)
meshActor.GetProperty().SetColor(1.0,1.0,0)
meshActor.GetProperty().BackfaceCullingOn()
# meshActor.GetProperty().SetEdgeColor(1,1,0.5)
# meshActor.GetProperty().EdgeVisibilityOn()
boxpoints = vtk.vtkPoints()
for n in range(8):

2
processing/post/vtk_rectilinearGrid.py
View File

@ -82,7 +82,7 @@ for name in filenames:
[coords[i][j-1] + coords[i][j] for j in range(1,len(coords[i]))] + \
[3.0 * coords[i][-1] - coords[i][-1 - int(len(coords[i]) > 1)]]) for i in range(3)]
grid = np.array(map(len,coords),'i')
grid = np.array(list(map(len,coords)),'i')
N = grid.prod() if options.mode == 'point' else (grid-1).prod()
if N != len(table.data):

12
processing/pre/geom_fromOsteonGeometry.py
View File

@ -55,9 +55,9 @@ parser.set_defaults(canal = 25e-6,
(options,filename) = parser.parse_args()
if np.any(options.grid < 2):
if np.any(np.array(options.grid) < 2):
parser('invalid grid a b c.')
if np.any(options.size <= 0.0):
if np.any(np.array(options.size) <= 0.0):
parser('invalid size x y z.')
# --- open input files ----------------------------------------------------------------------------
@ -114,12 +114,8 @@ for y in range(info['grid'][1]):
info['microstructures'] += 1
#--- report ---------------------------------------------------------------------------------------
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))),
'size x y z: %s'%(' x '.join(map(str,info['size']))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))),
'homogenization: %i'%info['homogenization'],
'microstructures: %i'%info['microstructures']])
# -------------------------------------- switch according to task ----------------------------------
damask.util.report_geom(info,['grid','size','origin','homogenization','microstructures'])
formatwidth = 1+int(math.floor(math.log10(info['microstructures']-1)))
header = [scriptID + ' ' + ' '.join(sys.argv[1:])]
header.append('<microstructure>')

10
processing/pre/geom_fromTable.py
View File

@ -1,7 +1,7 @@
#!/usr/bin/env python2.7
# -*- coding: UTF-8 no BOM -*-
import os,sys,math,types,time
import os,sys,math,time
import scipy.spatial, numpy as np
from optparse import OptionParser
import damask
@ -152,7 +152,7 @@ for name in filenames:
continue
table.data_readArray([options.pos] \
+ ([label] if isinstance(label, types.StringTypes) else label) \
+ (label if isinstance(label, list) else [label]) \
+ ([options.phase] if options.phase else []))
if coordDim == 2:
@ -165,9 +165,9 @@ for name in filenames:
# --------------- figure out size and grid ---------------------------------------------------------
coords = [np.unique(table.data[:,i]) for i in range(3)]
mincorner = np.array(map(min,coords))
maxcorner = np.array(map(max,coords))
grid = np.array(map(len,coords),'i')
mincorner = np.array(list(map(min,coords)))
maxcorner = np.array(list(map(max,coords)))
grid = np.array(list(map(len,coords)),'i')
size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1)
size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings
delta = size/np.maximum(np.ones(3,'d'), grid)

3
processing/pre/geom_fromVoronoiTessellation.py
View File

@ -15,8 +15,7 @@ scriptID = ' '.join([scriptName,damask.version])
def meshgrid2(*arrs):
"""Code inspired by http://stackoverflow.com/questions/1827489/numpy-meshgrid-in-3d"""
arrs = tuple(reversed(arrs))
arrs = tuple(arrs)
lens = np.array(map(len, arrs))
lens = np.array(list(map(len, arrs)))
dim = len(arrs)
ans = []
for i, arr in enumerate(arrs):

2
processing/pre/geom_translate.py
View File

@ -92,7 +92,7 @@ for name in filenames:
}
substituted = np.copy(microstructure)
for k, v in sub.iteritems(): substituted[microstructure==k] = v # substitute microstructure indices
for k, v in sub.items(): substituted[microstructure==k] = v # substitute microstructure indices
substituted += options.microstructure # shift microstructure indices

2
processing/pre/hybridIA_linODFsampling.py
View File

@ -270,7 +270,7 @@ for name in filenames:
ODF['limit'] = np.radians(limits[1,:]) # right hand limits in radians
ODF['center'] = 0.0 if all(limits[0,:]<1e-8) else 0.5 # vertex or cell centered
ODF['interval'] = np.array(map(len,[np.unique(table.data[:,i]) for i in range(3)]),'i') # steps are number of distict values
ODF['interval'] = np.array(list(map(len,[np.unique(table.data[:,i]) for i in range(3)])),'i') # steps are number of distict values
ODF['nBins'] = ODF['interval'].prod()
ODF['delta'] = np.radians(np.array(limits[1,0:3]-limits[0,0:3])/(ODF['interval']-1)) # step size

11
processing/pre/mentat_spectralBox.py
View File

@ -77,7 +77,14 @@ def mesh(r,d):
"%f %f %f"%(-d[0],d[1],d[2]),
"%f %f %f"%(-d[0],d[1],0.0),
"*add_elements",
range(1,9),
"1",
"2",
"3",
"4",
"5",
"6",
"7",
"8",
"*sub_divisions",
"%i %i %i"%(r[2],r[1],r[0]),
"*subdivide_elements",
@ -201,7 +208,7 @@ if options.port:
except:
parser.error('no valid Mentat release found.')
# --- loop over input files -------------------------------------------------------------------------
# --- loop over input files ------------------------------------------------------------------------
if filenames == []: filenames = [None]

2
processing/pre/patchFromReconstructedBoundaries.py
View File

@ -344,7 +344,7 @@ def rcbParser(content,M,size,tolerance,idcolumn,segmentcolumn):
else:
myNeighbors[grainNeighbors[leg][side]] = 1
if myNeighbors: # do I have any neighbors (i.e., non-bounding box segment)
candidateGrains = sorted(myNeighbors.iteritems(), key=lambda p: (p[1],p[0]), reverse=True) # sort grain counting
candidateGrains = sorted(myNeighbors.items(), key=lambda p: (p[1],p[0]), reverse=True) # sort grain counting
# most frequent one not yet seen?
rcData['grainMapping'].append(candidateGrains[0 if candidateGrains[0][0] not in rcData['grainMapping'] else 1][0]) # must be me then
# special case of bi-crystal situation...

27
src/CMakeLists.txt
View File

@ -17,13 +17,7 @@ list(APPEND OBJECTFILES $<TARGET_OBJECTS:SYSTEM_ROUTINES>)
add_library(PREC OBJECT "prec.f90")
list(APPEND OBJECTFILES $<TARGET_OBJECTS:PREC>)
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
add_library(DAMASK_INTERFACE OBJECT "spectral_interface.f90")
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(DAMASK_INTERFACE OBJECT "FEM_interface.f90")
else ()
message (FATAL_ERROR "Build target (PROJECT_NAME) is not defined")
endif()
add_library(DAMASK_INTERFACE OBJECT "DAMASK_interface.f90")
add_dependencies(DAMASK_INTERFACE PREC SYSTEM_ROUTINES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_INTERFACE>)
@ -31,8 +25,12 @@ add_library(IO OBJECT "IO.f90")
add_dependencies(IO DAMASK_INTERFACE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:IO>)
add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90")
add_dependencies(HDF5_UTILITIES IO)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:HDF5_UTILITIES>)
add_library(NUMERICS OBJECT "numerics.f90")
add_dependencies(NUMERICS IO)
add_dependencies(NUMERICS HDF5_UTILITIES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:NUMERICS>)
add_library(DEBUG OBJECT "debug.f90")
@ -57,7 +55,7 @@ if (PROJECT_NAME STREQUAL "DAMASK_spectral")
add_dependencies(MESH DAMASK_MATH)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MESH>)
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(FEZoo OBJECT "FEZoo.f90")
add_library(FEZoo OBJECT "FEM_zoo.f90")
add_dependencies(FEZoo DAMASK_MATH)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEZoo>)
add_library(MESH OBJECT "meshFEM.f90")
@ -175,25 +173,24 @@ if (PROJECT_NAME STREQUAL "DAMASK_spectral")
"spectral_mech_Basic.f90")
add_dependencies(SPECTRAL_SOLVER SPECTRAL_UTILITIES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:SPECTRAL_SOLVER>)
if(NOT CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
add_executable(DAMASK_spectral "DAMASK_spectral.f90" ${OBJECTFILES})
else()
add_library(DAMASK_spectral OBJECT "DAMASK_spectral.f90")
endif()
add_dependencies(DAMASK_spectral SPECTRAL_SOLVER)
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(FEM_UTILITIES OBJECT "FEM_utilities.f90")
add_dependencies(FEM_UTILITIES DAMASK_CPFE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEM_UTILITIES>)
add_library(FEM_SOLVER OBJECT
"FEM_hydrogenflux.f90"
"FEM_porosity.f90"
"FEM_vacancyflux.f90"
"FEM_damage.f90"
"FEM_thermal.f90"
"FEM_mech.f90")
add_dependencies(FEM_SOLVER FEM_UTILITIES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEM_SOLVER>)
add_executable(DAMASK_FEM "DAMASK_FEM_driver.f90")
add_executable(DAMASK_FEM "DAMASK_FEM.f90" ${OBJECTFILES})
add_dependencies(DAMASK_FEM FEM_SOLVER)
endif()

18
src/CPFEM2.f90
View File

@ -50,8 +50,8 @@ subroutine CPFEM_initAll(el,ip)
IO_init
use DAMASK_interface
#ifdef FEM
use FEZoo, only: &
FEZoo_init
use FEM_Zoo, only: &
FEM_Zoo_init
#endif
implicit none
@ -62,7 +62,7 @@ subroutine CPFEM_initAll(el,ip)
call prec_init
call IO_init
#ifdef FEM
call FEZoo_init
call FEM_Zoo_init
#endif
call numerics_init
call debug_init
@ -196,7 +196,7 @@ end subroutine CPFEM_init
!--------------------------------------------------------------------------------------------------
!> @brief perform initialization at first call, update variables and call the actual material model
!> @brief forwards data after successful increment
!--------------------------------------------------------------------------------------------------
subroutine CPFEM_age()
use prec, only: &
@ -212,16 +212,6 @@ subroutine CPFEM_age()
debug_levelSelective
use FEsolving, only: &
restartWrite
use math, only: &
math_identity2nd, &
math_mul33x33, &
math_det33, &
math_transpose33, &
math_I3, &
math_Mandel3333to66, &
math_Mandel66to3333, &
math_Mandel33to6, &
math_Mandel6to33
use material, only: &
plasticState, &
sourceState, &

654
src/DAMASK_FEM.f90 Normal file
View File

@ -0,0 +1,654 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Driver controlling inner and outer load case looping of the FEM solver
!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing
!> results
!--------------------------------------------------------------------------------------------------
program DAMASK_FEM
use, intrinsic :: &
iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment)
use prec, only: &
pInt, &
pReal, &
tol_math_check
use DAMASK_interface, only: &
DAMASK_interface_init, &
loadCaseFile, &
getSolverJobName
use IO, only: &
IO_read, &
IO_isBlank, &
IO_open_file, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_intValue, &
IO_error, &
IO_lc, &
IO_intOut, &
IO_warning, &
IO_timeStamp, &
IO_EOF
use debug, only: &
debug_level, &
debug_spectral, &
debug_levelBasic
use math ! need to include the whole module for FFTW
use CPFEM2, only: &
CPFEM_initAll
use FEsolving, only: &
restartWrite, &
restartInc
use numerics, only: &
maxCutBack, &
stagItMax, &
worldrank
use mesh, only: &
mesh_Nboundaries, &
mesh_boundaries, &
geomMesh
use FEM_Utilities, only: &
utilities_init, &
tSolutionState, &
tLoadCase, &
cutBack, &
maxFields, &
nActiveFields, &
FIELD_MECH_ID, &
FIELD_THERMAL_ID, &
FIELD_DAMAGE_ID, &
FIELD_SOLUTE_ID, &
FIELD_MGTWIN_ID, &
COMPONENT_MECH_X_ID, &
COMPONENT_MECH_Y_ID, &
COMPONENT_MECH_Z_ID, &
COMPONENT_THERMAL_T_ID, &
COMPONENT_DAMAGE_PHI_ID, &
COMPONENT_SOLUTE_CV_ID, &
COMPONENT_SOLUTE_CVPOT_ID, &
COMPONENT_SOLUTE_CH_ID, &
COMPONENT_SOLUTE_CHPOT_ID, &
COMPONENT_SOLUTE_CVaH_ID, &
COMPONENT_SOLUTE_CVaHPOT_ID, &
COMPONENT_MGTWIN_PHI_ID, &
FIELD_MECH_label, &
FIELD_THERMAL_label, &
FIELD_DAMAGE_label, &
FIELD_SOLUTE_label, &
FIELD_MGTWIN_label
use FEM_mech
implicit none
#include <petsc/finclude/petsc.h>
!--------------------------------------------------------------------------------------------------
! variables related to information from load case and geom file
integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature
integer(pInt), allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing
integer(pInt) :: &
N_def = 0_pInt !< # of rate of deformation specifiers found in load case file
character(len=65536) :: &
line
!--------------------------------------------------------------------------------------------------
! loop variables, convergence etc.
integer(pInt), parameter :: &
subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0
real(pReal) :: &
time = 0.0_pReal, & !< elapsed time
time0 = 0.0_pReal, & !< begin of interval
timeinc = 0.0_pReal, & !< current time interval
timeIncOld = 0.0_pReal, & !< previous time interval
remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case
logical :: &
guess !< guess along former trajectory
integer(pInt) :: &
i, &
errorID, &
cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
stepFraction = 0_pInt !< fraction of current time interval
integer(pInt) :: &
currentLoadcase = 0_pInt, & !< current load case
currentFace = 0_pInt, &
inc, & !< current increment in current load case
totalIncsCounter = 0_pInt, & !< total No. of increments
convergedCounter = 0_pInt, & !< No. of converged increments
notConvergedCounter = 0_pInt, & !< No. of non-converged increments
statUnit = 0_pInt, & !< file unit for statistics output
lastRestartWritten = 0_pInt !< total increment No. at which last restart information was written
integer(pInt) :: &
stagIter, &
component
logical :: &
stagIterate
character(len=6) :: loadcase_string
character(len=1024) :: incInfo !< string parsed to solution with information about current load case
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
type(tSolutionState), allocatable, dimension(:) :: solres
PetscInt :: faceSet, currentFaceSet
PetscInt :: field, dimPlex
PetscErrorCode :: ierr
external :: &
MPI_abort, &
DMGetDimension, &
DMGetLabelSize, &
DMGetLabelIdIS, &
ISDestroy, &
quit
!--------------------------------------------------------------------------------------------------
! init DAMASK (all modules)
call CPFEM_initAll(el = 1_pInt, ip = 1_pInt)
write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
! reading basic information from load case file and allocate data structure containing load cases
call DMGetDimension(geomMesh,dimPlex,ierr)! CHKERRQ(ierr) !< dimension of mesh (2D or 3D)
nActiveFields = 1
allocate(solres(nActiveFields))
!--------------------------------------------------------------------------------------------------
! reading basic information from load case file and allocate data structure containing load cases
call IO_open_file(FILEUNIT,trim(loadCaseFile))
rewind(FILEUNIT)
do
line = IO_read(FILEUNIT)
if (trim(line) == IO_EOF) exit
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
case('$loadcase')
N_def = N_def + 1_pInt
end select
enddo ! count all identifiers to allocate memory and do sanity check
enddo
allocate (loadCases(N_def))
do i = 1, size(loadCases)
allocate(loadCases(i)%fieldBC(nActiveFields))
field = 1
loadCases(i)%fieldBC(field)%ID = FIELD_MECH_ID
enddo
do i = 1, size(loadCases)
do field = 1, nActiveFields
select case (loadCases(i)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
loadCases(i)%fieldBC(field)%nComponents = dimPlex !< X, Y (, Z) displacements
allocate(loadCases(i)%fieldBC(field)%componentBC(loadCases(i)%fieldBC(field)%nComponents))
end select
do component = 1, loadCases(i)%fieldBC(field)%nComponents
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal)
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
enddo
enddo
enddo
!--------------------------------------------------------------------------------------------------
! reading the load case and assign values to the allocated data structure
rewind(FILEUNIT)
do
line = IO_read(FILEUNIT)
if (trim(line) == IO_EOF) exit
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1)
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
!--------------------------------------------------------------------------------------------------
! loadcase information
case('$loadcase')
currentLoadCase = IO_intValue(line,chunkPos,i+1_pInt)
case('face')
currentFace = IO_intValue(line,chunkPos,i+1_pInt)
currentFaceSet = -1_pInt
do faceSet = 1, mesh_Nboundaries
if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet
enddo
if (currentFaceSet < 0_pInt) call IO_error(error_ID = errorID, ext_msg = 'invalid BC')
case('t','time','delta') ! increment time
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt)
case('n','incs','increments','steps') ! number of increments
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt)
case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling)
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt)
loadCases(currentLoadCase)%logscale = 1_pInt
case('freq','frequency','outputfreq') ! frequency of result writings
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt)
case('r','restart','restartwrite') ! frequency of writing restart information
loadCases(currentLoadCase)%restartfrequency = &
max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt))
case('guessreset','dropguessing')
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
!--------------------------------------------------------------------------------------------------
! boundary condition information
case('x') ! X displacement field
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_X_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('y') ! Y displacement field
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Y_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('z') ! Z displacement field
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Z_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('temp','temperature') ! thermal field
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_THERMAL_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_THERMAL_T_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('mgtwin') ! mgtwin field
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MGTWIN_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MGTWIN_PHI_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('damage')
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_DAMAGE_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_DAMAGE_PHI_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('cv')
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CV_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('cvpot')
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CVPOT_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('ch')
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CH_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('chpot')
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CHPOT_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('cvah')
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CVaH_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
case('cvahpot')
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CVaHPOT_ID) then
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = &
.true.
loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = &
IO_floatValue(line,chunkPos,i+1_pInt)
endif
enddo
endif
enddo
end select
enddo; enddo
close(FILEUNIT)
!--------------------------------------------------------------------------------------------------
! consistency checks and output of load case
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
errorID = 0_pInt
if (worldrank == 0) then
checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases)
write (loadcase_string, '(i6)' ) currentLoadCase
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
write(6,'(2x,a)') 'drop guessing along trajectory'
do field = 1_pInt, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label)
case(FIELD_THERMAL_ID)
write(6,'(2x,a)') 'Field '//trim(FIELD_THERMAL_label)
case(FIELD_DAMAGE_ID)
write(6,'(2x,a)') 'Field '//trim(FIELD_DAMAGE_label)
case(FIELD_MGTWIN_ID)
write(6,'(2x,a)') 'Field '//trim(FIELD_MGTWIN_label)
case(FIELD_SOLUTE_ID)
write(6,'(2x,a)') 'Field '//trim(FIELD_SOLUTE_label)
end select
do faceSet = 1_pInt, mesh_Nboundaries
do component = 1_pInt, loadCases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), &
' Component ', component, &
' Value ', loadCases(currentLoadCase)%fieldBC(field)% &
componentBC(component)%Value(faceSet)
enddo
enddo
enddo
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency
write(6,'(2x,a,i5)') 'output frequency: ', &
loadCases(currentLoadCase)%outputfrequency
write(6,'(2x,a,i5,/)') 'restart frequency: ', &
loadCases(currentLoadCase)%restartfrequency
if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
enddo checkLoadcases
endif
!--------------------------------------------------------------------------------------------------
! doing initialization depending on selected solver
call Utilities_init()
do field = 1, nActiveFields
select case (loadCases(1)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
call FEM_mech_init(loadCases(1)%fieldBC(field))
end select
enddo
!--------------------------------------------------------------------------------------------------
! loopping over loadcases
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)
time0 = time ! currentLoadCase start time
if (loadCases(currentLoadCase)%followFormerTrajectory) then
guess = .true.
else
guess = .false. ! change of load case, homogeneous guess for the first inc
endif
!--------------------------------------------------------------------------------------------------
! loop oper incs defined in input file for current currentLoadCase
incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs
totalIncsCounter = totalIncsCounter + 1_pInt
!--------------------------------------------------------------------------------------------------
! forwarding time
timeIncOld = timeinc
if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale
timeinc = loadCases(currentLoadCase)%time/loadCases(currentLoadCase)%incs ! only valid for given linear time scale. will be overwritten later in case loglinear scale is used
else
if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale
if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
else ! not-1st inc of 1st currentLoadCase of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal))
endif
else ! not-1st currentLoadCase of logarithmic scale
timeinc = time0 * &
( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal))&
-(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( (inc-1_pInt),pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal)))
endif
endif
timeinc = timeinc / 2.0_pReal**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step
forwarding: if(totalIncsCounter >= restartInc) then
stepFraction = 0_pInt
!--------------------------------------------------------------------------------------------------
! loop over sub incs
subIncLooping: do while (stepFraction/subStepFactor**cutBackLevel <1_pInt)
time = time + timeinc ! forward time
stepFraction = stepFraction + 1_pInt
remainingLoadCaseTime = time0 - time + loadCases(currentLoadCase)%time + timeInc
!--------------------------------------------------------------------------------------------------
! report begin of new increment
if (worldrank == 0) then
write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,a,es12.5'//&
',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//&
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//&
',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') &
'Time', time, &
's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,&
'-', stepFraction, '/', subStepFactor**cutBackLevel,&
' of load case ', currentLoadCase,'/',size(loadCases)
flush(6)
write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases%incs))//&
',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') &
'Increment ',totalIncsCounter,'/',sum(loadCases%incs),&
'-',stepFraction, '/', subStepFactor**cutBackLevel
endif
!--------------------------------------------------------------------------------------------------
! forward fields
do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
call FEM_mech_forward (&
guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
end select
enddo
!--------------------------------------------------------------------------------------------------
! solve fields
stagIter = 0_pInt
stagIterate = .true.
do while (stagIterate)
do field = 1, nActiveFields
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
solres(field) = FEM_mech_solution (&
incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
end select
if(.not. solres(field)%converged) exit ! no solution found
enddo
stagIter = stagIter + 1_pInt
stagIterate = stagIter < stagItMax .and. &
all(solres(:)%converged) .and. &
.not. all(solres(:)%stagConverged)
enddo
! check solution
cutBack = .False.
if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found
if (cutBackLevel < maxCutBack) then ! do cut back
if (worldrank == 0) &
write(6,'(/,a)') ' cut back detected'
cutBack = .True.
stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator
cutBackLevel = cutBackLevel + 1_pInt
time = time - timeinc ! rewind time
timeinc = timeinc/2.0_pReal
else ! default behavior, exit if spectral solver does not converge
call IO_warning(850_pInt)
call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written (e.g. for regridding) ! continue from non-converged solution and start guessing after accepted (sub)inc
endif
else
guess = .true. ! start guessing after first converged (sub)inc
timeIncOld = timeinc
endif
if (.not. cutBack) then
if (worldrank == 0) write(statUnit,*) totalIncsCounter, time, cutBackLevel, &
solres%converged, solres%iterationsNeeded ! write statistics about accepted solution
endif
enddo subIncLooping
cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc
if(all(solres(:)%converged)) then ! report converged inc
convergedCounter = convergedCounter + 1_pInt
if (worldrank == 0) then
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') &
' increment ', totalIncsCounter, ' converged'
endif
else
if (worldrank == 0) then
write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc
' increment ', totalIncsCounter, ' NOT converged'
endif
notConvergedCounter = notConvergedCounter + 1_pInt
endif; flush(6)
if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency
if (worldrank == 0) then
write(6,'(1/,a)') ' ... writing results to file ......................................'
endif
endif
if( loadCases(currentLoadCase)%restartFrequency > 0_pInt .and. & ! at frequency of writing restart information set restart parameter for FEsolving
mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ToDo first call to CPFEM_general will write?
restartWrite = .true.
lastRestartWritten = inc
endif
else forwarding
time = time + timeinc
guess = .true.
endif forwarding
enddo incLooping
enddo loadCaseLooping
!--------------------------------------------------------------------------------------------------
! report summary of whole calculation
if (worldrank == 0) then
write(6,'(/,a)') ' ###########################################################################'
write(6,'(1x,i6.6,a,i6.6,a,f5.1,a)') convergedCounter, ' out of ', &
notConvergedCounter + convergedCounter, ' (', &
real(convergedCounter, pReal)/&
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, &
' %) increments converged!'
endif
if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged
call quit(0_pInt) ! no complains ;)
end program DAMASK_FEM
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief quit subroutine to mimic behavior of FEM solvers
!> @details exits the Spectral solver and reports time and duration. Exit code 0 signals
!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code
!> 2 signals request for regridding, increment of last saved restart information is written to
!> stderr. Exit code 3 signals no severe problems, but some increments did not converge
!--------------------------------------------------------------------------------------------------
subroutine quit(stop_id)
use prec, only: &
pInt
implicit none
integer(pInt), intent(in) :: stop_id
integer, dimension(8) :: dateAndTime ! type default integer
call date_and_time(values = dateAndTime)
write(6,'(/,a)') 'DAMASK terminated on:'
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)
if (stop_id == 0_pInt) stop 0 ! normal termination
if (stop_id < 0_pInt) then ! trigger regridding
write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt)
stop 2
endif
if (stop_id == 3_pInt) stop 3 ! not all incs converged
stop 1 ! error (message from IO_error)
end subroutine quit

58
src/DAMASK_abaqus.f
View File

@ -3,20 +3,12 @@
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @author Koen Janssens, Paul Scherrer Institut
!> @author Arun Prakash, Fraunhofer IWM
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief interfaces DAMASK with Abaqus/Standard
!> @details put the included file abaqus_v6.env in either your home or model directory,
!> it is a minimum Abaqus environment file containing all changes necessary to use the
!> DAMASK subroutine (see Abaqus documentation for more information on the use of abaqus_v6.env)
!--------------------------------------------------------------------------------------------------
#ifndef INT
#define INT 4
#endif
#ifndef FLOAT
#define FLOAT 8
#endif
#define Abaqus
#include "prec.f90"
@ -24,17 +16,29 @@
module DAMASK_interface
implicit none
character(len=4), dimension(2), parameter :: INPUTFILEEXTENSION = ['.pes','.inp']
character(len=4), parameter :: LOGFILEEXTENSION = '.log'
private
character(len=4), dimension(2), parameter, public :: INPUTFILEEXTENSION = ['.pes','.inp']
character(len=4), parameter, public :: LOGFILEEXTENSION = '.log'
public :: &
DAMASK_interface_init, &
getSolverJobName
contains
!--------------------------------------------------------------------------------------------------
!> @brief just reporting
!> @brief reports and sets working directory
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
use ifport, only: &
CHDIR
implicit none
integer, dimension(8) :: &
dateAndTime ! type default integer
integer :: lenOutDir,ierr
character(len=256) :: wd
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018'
@ -46,26 +50,19 @@ subroutine DAMASK_interface_init
dateAndTime(6),':',&
dateAndTime(7)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
call getoutdir(wd, lenOutDir)
ierr = CHDIR(wd)
if (ierr /= 0) then
write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist'
call quit(1)
endif
#include "compilation_info.f90"
end subroutine DAMASK_interface_init
!--------------------------------------------------------------------------------------------------
!> @brief using Abaqus/Standard function to get working directory name
!--------------------------------------------------------------------------------------------------
character(1024) function getSolverWorkingDirectoryName()
implicit none
integer :: lenOutDir
getSolverWorkingDirectoryName=''
call getoutdir(getSolverWorkingDirectoryName, lenOutDir)
getSolverWorkingDirectoryName=trim(getSolverWorkingDirectoryName)//'/'
end function getSolverWorkingDirectoryName
!--------------------------------------------------------------------------------------------------
!> @brief using Abaqus/Standard function to get solver job name
!--------------------------------------------------------------------------------------------------
@ -79,10 +76,17 @@ character(1024) function getSolverJobName()
end function getSolverJobName
end module DAMASK_interface
#include "commercialFEM_fileList.f90"
!--------------------------------------------------------------------------------------------------
!> @brief This is the Abaqus std user subroutine for defining material behavior
!--------------------------------------------------------------------------------------------------
subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
RPL,DDSDDT,DRPLDE,DRPLDT,STRAN,DSTRAN,&
TIME,DTIME,TEMP,DTEMP,PREDEF,DPRED,CMNAME,NDI,NSHR,NTENS,&

283
src/spectral_interface.f90 → src/DAMASK_interface.f90
View File

@ -1,12 +1,13 @@
!--------------------------------------------------------------------------------------------------
!> @author Jaeyong Jung, Max-Planck-Institut für Eisenforschung GmbH
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Interfacing between the spectral solver and the material subroutines provided
!> @brief Interfacing between the PETSc-based solvers and the material subroutines provided
!! by DAMASK
!> @details Interfacing between the spectral solver and the material subroutines provided
!> by DAMASK. Interpretating the command line arguments or, in case of called from f2py,
!> the arguments parsed to the init routine to get load case, geometry file, working
!> directory, etc.
!> @details Interfacing between the PETSc-based solvers and the material subroutines provided
!> by DAMASK. Interpretating the command line arguments to get load case, geometry file,
!> and working directory.
!--------------------------------------------------------------------------------------------------
module DAMASK_interface
use prec, only: &
@ -14,26 +15,23 @@ module DAMASK_interface
implicit none
private
logical, public, protected :: appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding)
integer(pInt), public, protected :: spectralRestartInc = 0_pInt !< Increment at which calculation starts
integer(pInt), public, protected :: &
interface_restartInc = 0_pInt !< Increment at which calculation starts
character(len=1024), public, protected :: &
geometryFile = '', & !< parameter given for geometry file
loadCaseFile = '' !< parameter given for load case file
character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons
public :: &
getSolverWorkingDirectoryName, &
getSolverJobName, &
DAMASK_interface_init
private :: &
storeWorkingDirectory, &
setWorkingDirectory, &
getGeometryFile, &
getLoadCaseFile, &
rectifyPath, &
makeRelativePath, &
IIO_stringValue, &
IIO_intValue, &
IIO_lc, &
IIO_stringPos
contains
@ -47,22 +45,36 @@ subroutine DAMASK_interface_init()
#include <petsc/finclude/petscsys.h>
#if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR!=9
===================================================================================================
3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x
===================================================================================================
======= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ===========================================
========== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ========================================
============= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =====================================
================ THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ==================================
=================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ===============================
====================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ============================
========================= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =========================
============================ THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ======================
=============================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ===================
================================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ================
===================================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =============
======================================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ==========
===================================================================================================
3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x
===================================================================================================
#endif
use PETScSys
use system_routines, only: &
getHostName
getHostName, &
getCWD
implicit none
character(len=1024) :: &
commandLine, & !< command line call as string
loadCaseArg ='', & !< -l argument given to DAMASK_spectral.exe
geometryArg ='', & !< -g argument given to DAMASK_spectral.exe
workingDirArg ='', & !< -w argument given to DAMASK_spectral.exe
hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME)
userName, & !< name of user calling DAMASK_spectral.exe
tag
loadcaseArg = '', & !< -l argument given to the executable
geometryArg = '', & !< -g argument given to the executable
workingDirArg = '', & !< -w argument given to the executable
userName !< name of user calling the executable
integer :: &
i, &
#ifdef _OPENMP
@ -75,7 +87,6 @@ subroutine DAMASK_interface_init()
integer, dimension(8) :: &
dateAndTime ! type default integer
PetscErrorCode :: ierr
logical :: error
external :: &
quit,&
PETScErrorF, & ! is called in the CHKERRQ macro
@ -113,8 +124,8 @@ subroutine DAMASK_interface_init()
endif mainProcess
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018'
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018'
write(6,'(/,a)') ' Version: '//DAMASKVERSION
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',&
@ -123,19 +134,16 @@ subroutine DAMASK_interface_init()
dateAndTime(6),':',&
dateAndTime(7)
write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
#include "compilation_info.f90"
call get_command(commandLine)
chunkPos = IIO_stringPos(commandLine)
do i = 1, chunkPos(1)
tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key
select case(tag)
do i = 2_pInt, chunkPos(1)
select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key
case ('-h','--help')
write(6,'(a)') ' #######################################################################'
write(6,'(a)') ' DAMASK_spectral:'
write(6,'(a)') ' The spectral method boundary value problem solver for'
write(6,'(a)') ' the Düsseldorf Advanced Material Simulation Kit'
write(6,'(a)') ' DAMASK Command Line Interface:'
write(6,'(a)') ' For PETSc-based solvers for the Düsseldorf Advanced Material Simulation Kit'
write(6,'(a,/)')' #######################################################################'
write(6,'(a,/)')' Valid command line switches:'
write(6,'(a)') ' --geom (-g, --geometry)'
@ -145,23 +153,14 @@ subroutine DAMASK_interface_init()
write(6,'(a)') ' --help (-h)'
write(6,'(/,a)')' -----------------------------------------------------------------------'
write(6,'(a)') ' Mandatory arguments:'
write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom'
write(6,'(a)') ' Specifies the location of the geometry definition file,'
write(6,'(a)') ' if no extension is given, .geom will be appended.'
write(6,'(a)') ' "PathToGeomFile" will be the working directory if not specified'
write(6,'(a)') ' via --workingdir.'
write(6,'(a)') ' Make sure the file "material.config" exists in the working'
write(6,'(a)') ' directory.'
write(6,'(a)') ' For further configuration place "numerics.config"'
write(6,'(a)')' and "numerics.config" in that directory.'
write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load'
write(6,'(a)') ' Specifies the location of the load case definition file,'
write(6,'(a)') ' if no extension is given, .load will be appended.'
write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom'
write(6,'(a)') ' Specifies the location of the geometry definition file.'
write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile'
write(6,'(a)') ' Specifies the location of the load case definition file.'
write(6,'(/,a)')' -----------------------------------------------------------------------'
write(6,'(a)') ' Optional arguments:'
write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory'
write(6,'(a)') ' Specifies the working directory and overwrites the default'
write(6,'(a)') ' "PathToGeomFile".'
write(6,'(a)') ' Specifies the working directory and overwrites the default ./'
write(6,'(a)') ' Make sure the file "material.config" exists in the working'
write(6,'(a)') ' directory.'
write(6,'(a)') ' For further configuration place "numerics.config"'
@ -170,7 +169,7 @@ subroutine DAMASK_interface_init()
write(6,'(a)') ' Reads in increment XX and continues with calculating'
write(6,'(a)') ' increment XX+1 based on this.'
write(6,'(a)') ' Appends to existing results file'
write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.spectralOut".'
write(6,'(a)') ' "NameOfGeom_NameOfLoadFile".'
write(6,'(a)') ' Works only if the restart information for increment XX'
write(6,'(a)') ' is available in the working directory.'
write(6,'(/,a)')' -----------------------------------------------------------------------'
@ -179,42 +178,42 @@ subroutine DAMASK_interface_init()
write(6,'(a,/)')' Prints this message and exits'
call quit(0_pInt) ! normal Termination
case ('-l', '--load', '--loadcase')
loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt)
if ( i < chunkPos(1)) loadcaseArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt))
case ('-g', '--geom', '--geometry')
geometryArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt)
if (i < chunkPos(1)) geometryArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt))
case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory')
workingDirArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt)
if (i < chunkPos(1)) workingDirArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt))
case ('-r', '--rs', '--restart')
spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt)
appendToOutFile = .true.
if (i < chunkPos(1)) then
interface_restartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt)
endif
end select
enddo
if (len(trim(loadcaseArg)) == 0 .or. len(trim(geometryArg)) == 0) then
if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then
write(6,'(a)') ' Please specify geometry AND load case (-h for help)'
call quit(1_pInt)
endif
workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg)))
if (len_trim(workingDirArg) > 0) call setWorkingDirectory(trim(workingDirArg))
geometryFile = getGeometryFile(geometryArg)
loadCaseFile = getLoadCaseFile(loadCaseArg)
call get_environment_variable('USER',userName)
error = getHostName(hostName)
write(6,'(a,a)') ' Host name: ', trim(hostName)
! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux
write(6,'(a,a)') ' Host name: ', trim(getHostName())
write(6,'(a,a)') ' User name: ', trim(userName)
write(6,'(a,a)') ' Command line call: ', trim(commandLine)
if (len(trim(workingDirArg)) > 0) &
write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg)
write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg)
write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg)
write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName())
write(6,'(a,a)') ' Working directory: ', trim(getCWD())
write(6,'(a,a)') ' Geometry file: ', trim(geometryFile)
write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile)
write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName())
if (SpectralRestartInc > 0_pInt) &
write(6,'(a,i6.6)') ' Restart from increment: ', spectralRestartInc
write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile
if (interface_restartInc > 0_pInt) &
write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc
end subroutine DAMASK_interface_init
@ -222,59 +221,33 @@ end subroutine DAMASK_interface_init
!--------------------------------------------------------------------------------------------------
!> @brief extract working directory from given argument or from location of geometry file,
!! possibly converting relative arguments to absolut path
!> @todo change working directory with call chdir(storeWorkingDirectory)?
!--------------------------------------------------------------------------------------------------
character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryArg)
subroutine setWorkingDirectory(workingDirectoryArg)
use system_routines, only: &
isDirectory, &
getCWD
getCWD, &
setCWD
implicit none
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
character(len=*), intent(in) :: geometryArg !< geometry argument
character(len=1024) :: cwd
logical :: error
character(len=1024) :: workingDirectory !< working directory argument
external :: quit
logical :: error
wdGiven: if (len(workingDirectoryArg)>0) then
absolutePath: if (workingDirectoryArg(1:1) == '/') then
storeWorkingDirectory = workingDirectoryArg
workingDirectory = workingDirectoryArg
else absolutePath
error = getCWD(cwd)
if (error) call quit(1_pInt)
storeWorkingDirectory = trim(cwd)//'/'//workingDirectoryArg
workingDirectory = getCWD()
workingDirectory = trim(workingDirectory)//'/'//workingDirectoryArg
endif absolutePath
if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= '/') &
storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it
else wdGiven
if (geometryArg(1:1) == '/') then ! absolute path given as command line argument
storeWorkingDirectory = geometryArg(1:scan(geometryArg,'/',back=.true.))
else
error = getCWD(cwd) ! relative path given as command line argument
if (error) call quit(1_pInt)
storeWorkingDirectory = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.))
endif
endif wdGiven
storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory))
if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists
write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist'
workingDirectory = trim(rectifyPath(workingDirectory))
error = setCWD(trim(workingDirectory))
if(error) then
write(6,'(a20,a,a16)') ' working directory "',trim(workingDirectory),'" does not exist'
call quit(1_pInt)
endif
end function storeWorkingDirectory
!--------------------------------------------------------------------------------------------------
!> @brief simply returns the private string workingDir
!--------------------------------------------------------------------------------------------------
character(len=1024) function getSolverWorkingDirectoryName()
implicit none
getSolverWorkingDirectoryName = workingDirectory
end function getSolverWorkingDirectoryName
end subroutine setWorkingDirectory
!--------------------------------------------------------------------------------------------------
@ -310,28 +283,12 @@ character(len=1024) function getGeometryFile(geometryParameter)
getCWD
implicit none
character(len=1024), intent(in) :: &
geometryParameter
character(len=1024) :: &
cwd
integer :: posExt, posSep
logical :: error
external :: quit
character(len=1024), intent(in) :: geometryParameter
getGeometryFile = geometryParameter
posExt = scan(getGeometryFile,'.',back=.true.)
posSep = scan(getGeometryFile,'/',back=.true.)
getGeometryFile = trim(geometryParameter)
if (scan(getGeometryFile,'/') /= 1) getGeometryFile = trim(getCWD())//'/'//trim(getGeometryFile)
getGeometryFile = makeRelativePath(trim(getCWD()), getGeometryFile)
if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present
if (scan(getGeometryFile,'/') /= 1) then ! relative path given as command line argument
error = getcwd(cwd)
if (error) call quit(1_pInt)
getGeometryFile = rectifyPath(trim(cwd)//'/'//getGeometryFile)
else
getGeometryFile = rectifyPath(getGeometryFile)
endif
getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile)
end function getGeometryFile
@ -344,55 +301,45 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter)
getCWD
implicit none
character(len=1024), intent(in) :: &
loadCaseParameter
character(len=1024) :: &
cwd
integer :: posExt, posSep
logical :: error
external :: quit
character(len=1024), intent(in) :: loadCaseParameter
getLoadCaseFile = loadcaseParameter
posExt = scan(getLoadCaseFile,'.',back=.true.)
posSep = scan(getLoadCaseFile,'/',back=.true.)
if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present
if (scan(getLoadCaseFile,'/') /= 1) then ! relative path given as command line argument
error = getcwd(cwd)
if (error) call quit(1_pInt)
getLoadCaseFile = rectifyPath(trim(cwd)//'/'//getLoadCaseFile)
else
getLoadCaseFile = rectifyPath(getLoadCaseFile)
endif
getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile)
getLoadCaseFile = trim(loadCaseParameter)
if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = trim(getCWD())//'/'//trim(getLoadCaseFile)
getLoadCaseFile = makeRelativePath(trim(getCWD()), getLoadCaseFile)
end function getLoadCaseFile
!--------------------------------------------------------------------------------------------------
!> @brief remove ../ and /./ from path
!> @brief remove ../, /./, and // from path.
!> @details works only if absolute path is given
!--------------------------------------------------------------------------------------------------
function rectifyPath(path)
implicit none
character(len=*) :: path
character(len=len_trim(path)) :: rectifyPath
character(len=1024) :: rectifyPath
integer :: i,j,k,l ! no pInt
!--------------------------------------------------------------------------------------------------
! remove /./ from path
l = len_trim(path)
rectifyPath = path
rectifyPath = trim(path)
l = len_trim(rectifyPath)
do i = l,3,-1
if (rectifyPath(i-2:i) == '/'//'.'//'/') &
rectifyPath(i-1:l) = rectifyPath(i+1:l)//' '
if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' '
enddo
!--------------------------------------------------------------------------------------------------
! remove // from path
l = len_trim(rectifyPath)
do i = l,2,-1
if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' '
enddo
!--------------------------------------------------------------------------------------------------
! remove ../ and corresponding directory from rectifyPath
l = len_trim(rectifyPath)
i = index(rectifyPath(i:l),'..'//'/')
i = index(rectifyPath(i:l),'../')
j = 0
do while (i > j)
j = scan(rectifyPath(1:i-2),'/',back=.true.)
@ -402,7 +349,7 @@ function rectifyPath(path)
rectifyPath(j+1:k-1) = rectifyPath(j+2:k)
rectifyPath(k:k) = ' '
endif
i = j+index(rectifyPath(j+1:l),'..'//'/')
i = j+index(rectifyPath(j+1:l),'../')
enddo
if(len_trim(rectifyPath) == 0) rectifyPath = '/'
@ -415,20 +362,24 @@ end function rectifyPath
character(len=1024) function makeRelativePath(a,b)
implicit none
character (len=*) :: a,b
character (len=*), intent(in) :: a,b
character (len=1024) :: a_cleaned,b_cleaned
integer :: i,posLastCommonSlash,remainingSlashes !no pInt
posLastCommonSlash = 0
remainingSlashes = 0
a_cleaned = rectifyPath(trim(a)//'/')
b_cleaned = rectifyPath(b)
do i = 1, min(1024,len_trim(a),len_trim(b))
if (a(i:i) /= b(i:i)) exit
if (a(i:i) == '/') posLastCommonSlash = i
do i = 1, min(1024,len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned)))
if (a_cleaned(i:i) /= b_cleaned(i:i)) exit
if (a_cleaned(i:i) == '/') posLastCommonSlash = i
enddo
do i = posLastCommonSlash+1,len_trim(a)
if (a(i:i) == '/') remainingSlashes = remainingSlashes + 1
do i = posLastCommonSlash+1,len_trim(a_cleaned)
if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1
enddo
makeRelativePath = repeat('..'//'/',remainingSlashes)//b(posLastCommonSlash+1:len_trim(b))
makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned))
end function makeRelativePath
@ -441,15 +392,10 @@ pure function IIO_stringValue(string,chunkPos,myChunk)
implicit none
integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string
integer(pInt), intent(in) :: myChunk !< position number of desired chunk
character(len=1+chunkPos(myChunk*2+1)-chunkPos(myChunk*2)) :: IIO_stringValue
character(len=chunkPos(myChunk*2+1)-chunkPos(myChunk*2)+1) :: IIO_stringValue
character(len=*), intent(in) :: string !< raw input with known start and end of each chunk
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then
IIO_stringValue = ''
else valuePresent
IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1))
endif valuePresent
end function IIO_stringValue
@ -476,29 +422,6 @@ integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk)
end function IIO_intValue
!--------------------------------------------------------------------------------------------------
!> @brief taken from IO, check IO_lc for documentation
!--------------------------------------------------------------------------------------------------
pure function IIO_lc(string)
implicit none
character(len=*), intent(in) :: string !< string to convert
character(len=len(string)) :: IIO_lc
character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz'
character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
integer :: i,n ! no pInt (len returns default integer)
IIO_lc = string
do i=1,len(string)
n = index(UPPER,IIO_lc(i:i))
if (n/=0) IIO_lc(i:i) = LOWER(n:n)
enddo
end function IIO_lc
!--------------------------------------------------------------------------------------------------
!> @brief taken from IO, check IO_stringPos for documentation
!--------------------------------------------------------------------------------------------------

76
src/DAMASK_marc.f90
View File

@ -1,15 +1,3 @@
#define QUOTE(x) #x
#define PASTE(x,y) x ## y
#ifndef INT
#define INT 4
#endif
#ifndef FLOAT
#define FLOAT 8
#endif
#include "prec.f90"
!--------------------------------------------------------------------------------------------------
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
@ -17,13 +5,12 @@
!> @author W.A. Counts
!> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Material subroutine for MSC.Marc
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Interfaces DAMASK with MSC.Marc
!> @details Usage:
!> @details - choose material as hypela2
!> @details - set statevariable 2 to index of homogenization
!> @details - set statevariable 3 to index of microstructure
!> @details - make sure the file "material.config" exists in the working directory
!> @details - make sure the file "numerics.config" exists in the working directory
!> @details - use nonsymmetric option for solver (e.g. direct profile or multifrontal sparse, the latter seems to be faster!)
!> @details - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used, i.e uncheck "non-symmetric"
!> @details Marc subroutines used:
@ -34,23 +21,36 @@
!> @details - concom: lovl, inc
!> @details - creeps: timinc
!--------------------------------------------------------------------------------------------------
#define QUOTE(x) #x
#define PASTE(x,y) x ## y
#include "prec.f90"
module DAMASK_interface
implicit none
character(len=4), parameter :: InputFileExtension = '.dat'
character(len=4), parameter :: LogFileExtension = '.log'
private
character(len=4), parameter, public :: InputFileExtension = '.dat'
character(len=4), parameter, public :: LogFileExtension = '.log'
public :: &
DAMASK_interface_init, &
getSolverJobName
contains
!--------------------------------------------------------------------------------------------------
!> @brief only output of current version
!> @brief reports and sets working directory
!--------------------------------------------------------------------------------------------------
subroutine DAMASK_interface_init
use ifport, only: &
CHDIR
implicit none
integer, dimension(8) :: &
dateAndTime ! type default integer
integer :: ierr
character(len=1024) :: wd
call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>'
@ -64,27 +64,17 @@ subroutine DAMASK_interface_init
dateAndTime(7)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
#include "compilation_info.f90"
inquire(5, name=wd) ! determine inputputfile
wd = wd(1:scan(wd,'/',back=.true.))
ierr = CHDIR(wd)
if (ierr /= 0) then
write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist'
call quit(1)
endif
end subroutine DAMASK_interface_init
!--------------------------------------------------------------------------------------------------
!> @brief returns the current workingDir
!--------------------------------------------------------------------------------------------------
function getSolverWorkingDirectoryName()
implicit none
character(1024) getSolverWorkingDirectoryName, inputName
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
getSolverWorkingDirectoryName=''
inputName=''
inquire(5, name=inputName) ! determine inputputfile
getSolverWorkingDirectoryName=inputName(1:scan(inputName,pathSep,back=.true.))
end function getSolverWorkingDirectoryName
!--------------------------------------------------------------------------------------------------
!> @brief solver job name (no extension) as combination of geometry and load case name
!--------------------------------------------------------------------------------------------------
@ -109,6 +99,9 @@ end function getSolverJobName
end module DAMASK_interface
#include "commercialFEM_fileList.f90"
!--------------------------------------------------------------------------------------------------
@ -118,17 +111,6 @@ end module DAMASK_interface
!> @details
!> @details (2) Use the -> 'Plasticity,3' card(=update+finite+large disp+constant d)
!> @details in the parameter section of input deck (updated Lagrangian formulation).
!> @details
!> @details The following operation obtains U (stretch tensor) at t=n+1 :
!> @details
!> @details call scla(un1,0.d0,itel,itel,1)
!> @details do k=1,3
!> @details do i=1,3
!> @details do j=1,3
!> @details un1(i,j)=un1(i,j)+dsqrt(strechn1(k))*eigvn1(i,k)*eigvn1(j,k)
!> @details enddo
!> @details enddo
!> @details enddo
!--------------------------------------------------------------------------------------------------
subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, &

327
src/DAMASK_spectral.f90
View File

@ -24,13 +24,10 @@ program DAMASK_spectral
DAMASK_interface_init, &
loadCaseFile, &
geometryFile, &
getSolverWorkingDirectoryName, &
getSolverJobName, &
appendToOutFile
interface_restartInc
use IO, only: &
IO_read, &
IO_isBlank, &
IO_open_file, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
@ -39,8 +36,7 @@ program DAMASK_spectral
IO_lc, &
IO_intOut, &
IO_warning, &
IO_timeStamp, &
IO_EOF
IO_timeStamp
use debug, only: &
debug_level, &
debug_spectral, &
@ -91,7 +87,6 @@ program DAMASK_spectral
! variables related to information from load case and geom file
real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors
integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: &
@ -119,7 +114,7 @@ program DAMASK_spectral
stagIterate
integer(pInt) :: &
i, j, k, l, field, &
errorID, &
errorID = 0_pInt, &
cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
stepFraction = 0_pInt !< fraction of current time interval
integer(pInt) :: &
@ -128,13 +123,17 @@ program DAMASK_spectral
totalIncsCounter = 0_pInt, & !< total # of increments
convergedCounter = 0_pInt, & !< # of converged increments
notConvergedCounter = 0_pInt, & !< # of non-converged increments
resUnit = 0_pInt, & !< file unit for results writing
fileUnit = 0_pInt, & !< file unit for reading load case and writing results
myStat, &
statUnit = 0_pInt, & !< file unit for statistics output
lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written
stagIter
character(len=6) :: loadcase_string
character(len=1024) :: incInfo !< string parsed to solution with information about current load case
character(len=1024) :: &
incInfo, & !< string parsed to solution with information about current load case
workingDir
type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases
type(tLoadCase) :: newLoadCase
type(tSolutionState), allocatable, dimension(:) :: solres
integer(MPI_OFFSET_KIND) :: fileOffset
integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize
@ -142,6 +141,12 @@ program DAMASK_spectral
integer(pInt), parameter :: maxRealOut = maxByteOut/pReal
integer(pLongInt), dimension(2) :: outputIndex
integer :: ierr
procedure(basic_init), pointer :: &
mech_init
procedure(basic_forward), pointer :: &
mech_forward
procedure(basic_solution), pointer :: &
mech_solution
external :: &
quit
@ -161,15 +166,40 @@ program DAMASK_spectral
if (any(thermal_type == THERMAL_conduction_ID )) nActiveFields = nActiveFields + 1
if (any(damage_type == DAMAGE_nonlocal_ID )) nActiveFields = nActiveFields + 1
allocate(solres(nActiveFields))
allocate(newLoadCase%ID(nActiveFields))
!--------------------------------------------------------------------------------------------------
! reading basic information from load case file and allocate data structure containing load cases
call IO_open_file(FILEUNIT,trim(loadCaseFile))
rewind(FILEUNIT)
! assign mechanics solver depending on selected type
select case (spectral_solver)
case (DAMASK_spectral_SolverBasic_label)
mech_init => basic_init
mech_forward => basic_forward
mech_solution => basic_solution
case (DAMASK_spectral_SolverPolarisation_label)
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
call IO_warning(42_pInt, ext_msg='debug Divergence')
mech_init => polarisation_init
mech_forward => polarisation_forward
mech_solution => polarisation_solution
case default
call IO_error(error_ID = 891_pInt, ext_msg = trim(spectral_solver))
end select
!--------------------------------------------------------------------------------------------------
! reading information from load case file and to sanity checks
allocate (loadCases(0)) ! array of load cases
open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read')
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile))
do
line = IO_read(FILEUNIT)
if (trim(line) == IO_EOF) exit
read(fileUnit, '(A)', iostat=myStat) line
if ( myStat /= 0_pInt) exit
if (IO_isBlank(line)) cycle ! skip empty lines
currentLoadCase = currentLoadCase + 1_pInt
chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
@ -180,83 +210,65 @@ program DAMASK_spectral
case('n','incs','increments','steps','logincs','logincrements','logsteps')
N_n = N_n + 1_pInt
end select
enddo ! count all identifiers to allocate memory and do sanity check
enddo
if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check
call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase
allocate (loadCases(N_n)) ! array of load cases
loadCases%stress%myType='stress'
call IO_error(error_ID=837_pInt,el=currentLoadCase,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase
do i = 1, size(loadCases)
allocate(loadCases(i)%ID(nActiveFields))
newLoadCase%stress%myType='stress'
field = 1
loadCases(i)%ID(field) = FIELD_MECH_ID ! mechanical active by default
newLoadCase%ID(field) = FIELD_MECH_ID ! mechanical active by default
thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then
field = field + 1
loadCases(i)%ID(field) = FIELD_THERMAL_ID
newLoadCase%ID(field) = FIELD_THERMAL_ID
endif thermalActive
damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then
field = field + 1
loadCases(i)%ID(field) = FIELD_DAMAGE_ID
newLoadCase%ID(field) = FIELD_DAMAGE_ID
endif damageActive
enddo
!--------------------------------------------------------------------------------------------------
! reading the load case and assign values to the allocated data structure
rewind(FILEUNIT)
do
line = IO_read(FILEUNIT)
if (trim(line) == IO_EOF) exit
if (IO_isBlank(line)) cycle ! skip empty lines
currentLoadCase = currentLoadCase + 1_pInt
chunkPos = IO_stringPos(line)
do i = 1_pInt, chunkPos(1)
readIn: do i = 1_pInt, chunkPos(1)
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix
temp_valueVector = 0.0_pReal
if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'fdot'.or. & ! in case of Fdot, set type to fdot
IO_lc(IO_stringValue(line,chunkPos,i)) == 'dotf') then
loadCases(currentLoadCase)%deformation%myType = 'fdot'
newLoadCase%deformation%myType = 'fdot'
else if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'f') then
loadCases(currentLoadCase)%deformation%myType = 'f'
newLoadCase%deformation%myType = 'f'
else
loadCases(currentLoadCase)%deformation%myType = 'l'
newLoadCase%deformation%myType = 'l'
endif
do j = 1_pInt, 9_pInt
temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a *
if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable
enddo
loadCases(currentLoadCase)%deformation%maskLogical = & ! logical mask in 3x3 notation
transpose(reshape(temp_maskVector,[ 3,3]))
loadCases(currentLoadCase)%deformation%maskFloat = & ! float (1.0/0.0) mask in 3x3 notation
merge(ones,zeros,loadCases(currentLoadCase)%deformation%maskLogical)
loadCases(currentLoadCase)%deformation%values = math_plain9to33(temp_valueVector) ! values 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%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation
case('p','pk1','piolakirchhoff','stress', 's')
temp_valueVector = 0.0_pReal
do j = 1_pInt, 9_pInt
temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk
if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable
enddo
loadCases(currentLoadCase)%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3]))
loadCases(currentLoadCase)%stress%maskFloat = merge(ones,zeros,&
loadCases(currentLoadCase)%stress%maskLogical)
loadCases(currentLoadCase)%stress%values = math_plain9to33(temp_valueVector)
newLoadCase%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3]))
newLoadCase%stress%maskFloat = merge(ones,zeros,newLoadCase%stress%maskLogical)
newLoadCase%stress%values = math_plain9to33(temp_valueVector)
case('t','time','delta') ! increment time
loadCases(currentLoadCase)%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
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt)
newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt)
case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling)
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt)
loadCases(currentLoadCase)%logscale = 1_pInt
newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt)
newLoadCase%logscale = 1_pInt
case('freq','frequency','outputfreq') ! frequency of result writings
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt)
newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt)
case('r','restart','restartwrite') ! frequency of writing restart information
loadCases(currentLoadCase)%restartfrequency = &
newLoadCase%restartfrequency = &
max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt))
case('guessreset','dropguessing')
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
case('euler') ! rotation of currentLoadCase given in euler angles
newLoadCase%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
case('euler') ! rotation of load case given in euler angles
temp_valueVector = 0.0_pReal
l = 1_pInt ! assuming values given in degrees
k = 1_pInt ! assuming keyword indicating degree/radians present
@ -271,108 +283,90 @@ program DAMASK_spectral
temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j)
enddo
if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad
loadCases(currentLoadCase)%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix
case('rotation','rot') ! assign values for the rotation of currentLoadCase matrix
newLoadCase%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix
case('rotation','rot') ! assign values for the rotation matrix
temp_valueVector = 0.0_pReal
do j = 1_pInt, 9_pInt
temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j)
enddo
loadCases(currentLoadCase)%rotation = math_plain9to33(temp_valueVector)
newLoadCase%rotation = math_plain9to33(temp_valueVector)
end select
enddo; enddo
close(FILEUNIT)
enddo readIn
!--------------------------------------------------------------------------------------------------
! consistency checks and output of load case
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
errorID = 0_pInt
if (worldrank == 0) then
checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases)
newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1_pInt) ! by default, guess from previous load case
reportAndCheck: if (worldrank == 0) then
write (loadcase_string, '(i6)' ) currentLoadCase
write(6,'(1x,a,i6)') 'load case: ', currentLoadCase
if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
write(6,'(2x,a)') 'drop guessing along trajectory'
if (loadCases(currentLoadCase)%deformation%myType == 'l') then
if (.not. newLoadCase%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory'
if (newLoadCase%deformation%myType == 'l') then
do j = 1_pInt, 3_pInt
if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. &
any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) &
errorID = 832_pInt ! each row should be either fully or not at all defined
if (any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .true.) .and. &
any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832_pInt ! each row should be either fully or not at all defined
enddo
write(6,'(2x,a)') 'velocity gradient:'
else if (loadCases(currentLoadCase)%deformation%myType == 'f') then
else if (newLoadCase%deformation%myType == 'f') then
write(6,'(2x,a)') 'deformation gradient at end of load case:'
else
write(6,'(2x,a)') 'deformation gradient rate:'
endif
do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt
if(loadCases(currentLoadCase)%deformation%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%deformation%values(i,j)
if(newLoadCase%deformation%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') newLoadCase%deformation%values(i,j)
else
write(6,'(2x,12a)',advance='no') ' * '
endif
enddo; write(6,'(/)',advance='no')
enddo
if (any(loadCases(currentLoadCase)%stress%maskLogical .eqv. &
loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only
if (any(loadCases(currentLoadCase)%stress%maskLogical .and. &
transpose(loadCases(currentLoadCase)%stress%maskLogical) .and. &
if (any(newLoadCase%stress%maskLogical .eqv. &
newLoadCase%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only
if (any(newLoadCase%stress%maskLogical .and. &
transpose(newLoadCase%stress%maskLogical) .and. &
reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) &
errorID = 838_pInt ! no rotation is allowed by stress BC
write(6,'(2x,a)') 'stress / GPa:'
do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt
if(loadCases(currentLoadCase)%stress%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%stress%values(i,j)*1e-9_pReal
if(newLoadCase%stress%maskLogical(i,j)) then
write(6,'(2x,f12.7)',advance='no') newLoadCase%stress%values(i,j)*1e-9_pReal
else
write(6,'(2x,12a)',advance='no') ' * '
endif
enddo; write(6,'(/)',advance='no')
enddo
if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation, &
math_transpose33(loadCases(currentLoadCase)%rotation))-math_I3) > &
if (any(abs(math_mul33x33(newLoadCase%rotation, &
transpose(newLoadCase%rotation))-math_I3) > &
reshape(spread(tol_math_check,1,9),[ 3,3]))&
.or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > &
.or. abs(math_det33(newLoadCase%rotation)) > &
1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain
if (any(dNeq(loadCases(currentLoadCase)%rotation, math_I3))) &
if (any(dNeq(newLoadCase%rotation, math_I3))) &
write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',&
math_transpose33(loadCases(currentLoadCase)%rotation)
if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment
write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time
if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count
write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs
if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency
write(6,'(2x,a,i5)') 'output frequency: ', &
loadCases(currentLoadCase)%outputfrequency
write(6,'(2x,a,i5,/)') 'restart frequency: ', &
loadCases(currentLoadCase)%restartfrequency
transpose(newLoadCase%rotation)
if (newLoadCase%time < 0.0_pReal) errorID = 834_pInt ! negative time increment
write(6,'(2x,a,f12.6)') 'time: ', newLoadCase%time
if (newLoadCase%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count
write(6,'(2x,a,i5)') 'increments: ', newLoadCase%incs
if (newLoadCase%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency
write(6,'(2x,a,i5)') 'output frequency: ', newLoadCase%outputfrequency
write(6,'(2x,a,i5,/)') 'restart frequency: ', newLoadCase%restartfrequency
if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message
enddo checkLoadcases
endif
endif reportAndCheck
loadCases = [loadCases,newLoadCase] ! load case is ok, append it
enddo
close(fileUnit)
!--------------------------------------------------------------------------------------------------
! doing initialization depending on selected solver
! doing initialization depending on active solvers
call Utilities_init()
do field = 1, nActiveFields
select case (loadCases(1)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasic_label)
call basic_init
case (DAMASK_spectral_SolverPolarisation_label)
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
call IO_warning(42_pInt, ext_msg='debug Divergence')
call Polarisation_init
case default
call IO_error(error_ID = 891_pInt, ext_msg = trim(spectral_solver))
end select
call mech_init
case(FIELD_THERMAL_ID)
call spectral_thermal_init
case(FIELD_DAMAGE_ID)
call spectral_damage_init()
call spectral_damage_init
end select
enddo
@ -380,33 +374,33 @@ program DAMASK_spectral
!--------------------------------------------------------------------------------------------------
! write header of output file
if (worldrank == 0) then
if (.not. appendToOutFile) then ! after restart, append to existing results file
open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
writeHeader: if (interface_restartInc < 1_pInt) then
open(newunit=fileUnit,file=trim(getSolverJobName())//&
'.spectralOut',form='UNFORMATTED',status='REPLACE')
write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header
write(resUnit) 'workingdir:', trim(getSolverWorkingDirectoryName())
write(resUnit) 'geometry:', trim(geometryFile)
write(resUnit) 'grid:', grid
write(resUnit) 'size:', geomSize
write(resUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults
write(resUnit) 'loadcases:', size(loadCases)
write(resUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase
write(resUnit) 'times:', loadCases%time ! one entry per LoadCase
write(resUnit) 'logscales:', loadCases%logscale
write(resUnit) 'increments:', loadCases%incs ! one entry per LoadCase
write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc
write(resUnit) 'eoh'
close(resUnit) ! end of header
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header
write(fileUnit) 'workingdir:', trim(workingDir)
write(fileUnit) 'geometry:', trim(geometryFile)
write(fileUnit) 'grid:', grid
write(fileUnit) 'size:', geomSize
write(fileUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults
write(fileUnit) 'loadcases:', size(loadCases)
write(fileUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase
write(fileUnit) 'times:', loadCases%time ! one entry per LoadCase
write(fileUnit) 'logscales:', loadCases%logscale
write(fileUnit) 'increments:', loadCases%incs ! one entry per LoadCase
write(fileUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc
write(fileUnit) 'eoh'
close(fileUnit) ! end of header
open(newunit=statUnit,file=trim(getSolverJobName())//&
'.sta',form='FORMATTED',status='REPLACE')
write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file
if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) &
write(6,'(/,a)') ' header of result and statistics file written out'
flush(6)
else ! open new files ...
open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//&
else writeHeader
open(newunit=statUnit,file=trim(getSolverJobName())//&
'.sta',form='FORMATTED', position='APPEND', status='OLD')
endif
endif writeHeader
endif
!--------------------------------------------------------------------------------------------------
@ -415,40 +409,39 @@ program DAMASK_spectral
outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND)
call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce')
call MPI_file_open(PETSC_COMM_WORLD, &
trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.spectralOut', &
call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', &
MPI_MODE_WRONLY + MPI_MODE_APPEND, &
MPI_INFO_NULL, &
resUnit, &
fileUnit, &
ierr)
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_open')
call MPI_file_get_position(resUnit,fileOffset,ierr) ! get offset from header
call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_get_position')
fileOffset = fileOffset + sum(outputSize(1:worldrank)) ! offset of my process in file (header + processes before me)
call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr)
call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr)
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek')
if (.not. appendToOutFile) then ! if not restarting, write 0th increment
writeUndeformed: if (interface_restartInc < 1_pInt) then
write(6,'(1/,a)') ' ... writing initial configuration to file ........................'
do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1?
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), &
call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), &
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), &
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write')
enddo
fileOffset = fileOffset + sum(outputSize) ! forward to current file position
endif
endif writeUndeformed
!--------------------------------------------------------------------------------------------------
! looping over load cases
loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)
time0 = time ! currentLoadCase start time
time0 = time ! load case start time
guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc
!--------------------------------------------------------------------------------------------------
! loop over incs defined in input file for current currentLoadCase
! loop over incs defined in input file for current load case
incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs
totalIncsCounter = totalIncsCounter + 1_pInt
@ -458,13 +451,13 @@ program DAMASK_spectral
if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale
timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
else
if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale
if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale
if (currentLoadCase == 1_pInt) then ! 1st load case of logarithmic scale
if (inc == 1_pInt) then ! 1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
else ! not-1st inc of 1st currentLoadCase of logarithmic scale
else ! not-1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal))
endif
else ! not-1st currentLoadCase of logarithmic scale
else ! not-1st load case of logarithmic scale
timeinc = time0 * &
( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc ,pReal)/&
real(loadCases(currentLoadCase)%incs ,pReal))&
@ -512,22 +505,12 @@ program DAMASK_spectral
do field = 1, nActiveFields
select case(loadCases(currentLoadCase)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasic_label)
call Basic_forward (&
call mech_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, &
deformation_BC = loadCases(currentLoadCase)%deformation, &
stress_BC = loadCases(currentLoadCase)%stress, &
rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverPolarisation_label)
call Polarisation_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, &
deformation_BC = loadCases(currentLoadCase)%deformation, &
stress_BC = loadCases(currentLoadCase)%stress, &
rotation_BC = loadCases(currentLoadCase)%rotation)
end select
case(FIELD_THERMAL_ID); call spectral_thermal_forward()
case(FIELD_DAMAGE_ID); call spectral_damage_forward()
end select
@ -541,21 +524,11 @@ program DAMASK_spectral
do field = 1, nActiveFields
select case(loadCases(currentLoadCase)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasic_label)
solres(field) = Basic_solution (&
solres(field) = mech_solution (&
incInfo,timeinc,timeIncOld, &
stress_BC = loadCases(currentLoadCase)%stress, &
rotation_BC = loadCases(currentLoadCase)%rotation)
case (DAMASK_spectral_SolverPolarisation_label)
solres(field) = Polarisation_solution (&
incInfo,timeinc,timeIncOld, &
stress_BC = loadCases(currentLoadCase)%stress, &
rotation_BC = loadCases(currentLoadCase)%rotation)
end select
case(FIELD_THERMAL_ID)
solres(field) = spectral_thermal_solution(timeinc,timeIncOld,remainingLoadCaseTime)
@ -595,7 +568,7 @@ program DAMASK_spectral
write(6,'(/,a)') ' cutting back '
else ! no more options to continue
call IO_warning(850_pInt)
call MPI_file_close(resUnit,ierr)
call MPI_file_close(fileUnit,ierr)
close(statUnit)
call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written
endif
@ -618,12 +591,12 @@ program DAMASK_spectral
write(6,'(1/,a)') ' ... writing results to file ......................................'
flush(6)
call materialpoint_postResults()
call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr)
call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr)
if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek')
do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, &
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),&
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
@ -651,10 +624,9 @@ program DAMASK_spectral
convergedCounter, ' out of ', &
notConvergedCounter + convergedCounter, ' (', &
real(convergedCounter, pReal)/&
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, &
' %) increments converged!'
real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!'
flush(6)
call MPI_file_close(resUnit,ierr)
call MPI_file_close(fileUnit,ierr)
close(statUnit)
if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged
@ -673,7 +645,10 @@ end program DAMASK_spectral
!--------------------------------------------------------------------------------------------------
subroutine quit(stop_id)
#include <petsc/finclude/petscsys.h>
use MPI
#ifdef _OPENMP
use MPI, only: &
MPI_finalize
#endif
use prec, only: &
pInt

734
src/FEM_mech.f90 Normal file
View File

@ -0,0 +1,734 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief FEM PETSc solver
!--------------------------------------------------------------------------------------------------
module FEM_mech
#include <petsc/finclude/petsc.h>
use PETScdmda
use PETScsnes
use PETScDM
use PETScDMplex
use prec, only: &
pInt, &
pReal
use math, only: &
math_I3
use FEM_utilities, only: &
tSolutionState, &
tFieldBC, &
tComponentBC
use numerics, only: &
worldrank, &
worldsize
use mesh, only: &
mesh_Nboundaries, &
mesh_boundaries
implicit none
private
!--------------------------------------------------------------------------------------------------
! derived types
type tSolutionParams
type(tFieldBC) :: fieldBC
real(pReal) :: timeinc
real(pReal) :: timeincOld
end type tSolutionParams
type(tSolutionParams), private :: params
!--------------------------------------------------------------------------------------------------
! PETSc data
SNES, private :: mech_snes
Vec, private :: solution, solution_rate, solution_local
PetscInt, private :: dimPlex, cellDof, nQuadrature, nBasis
PetscReal, allocatable, target,dimension(:), private :: qPoints, qWeights
MatNullSpace, private :: matnull
!--------------------------------------------------------------------------------------------------
! stress, stiffness and compliance average etc.
character(len=1024), private :: incInfo
real(pReal), private, dimension(3,3) :: &
P_av = 0.0_pReal
logical, private :: ForwardData
real(pReal), parameter, private :: eps = 1.0e-18_pReal
public :: &
FEM_mech_init, &
FEM_mech_solution ,&
FEM_mech_forward, &
FEM_mech_destroy
external :: &
MatZeroRowsColumnsLocalIS, &
PetscQuadratureCreate, &
PetscFECreateDefault, &
PetscFESetQuadrature, &
PetscFEGetDimension, &
PetscFEDestroy, &
PetscFEGetDualSpace, &
PetscQuadratureDestroy, &
PetscDSSetDiscretization, &
PetscDSGetTotalDimension, &
PetscDSGetDiscretization, &
PetscDualSpaceGetFunctional, &
DMGetLabelSize, &
DMSNESSetFunctionLocal, &
DMSNESSetJacobianLocal, &
SNESSetOptionsPrefix, &
SNESSetConvergenceTest, &
PetscObjectSetName
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_init(fieldBC)
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment)
use IO, only: &
IO_timeStamp, &
IO_error
use DAMASK_interface, only: &
getSolverJobName
use mesh, only: &
geomMesh
use numerics, only: &
worldrank, &
itmax, &
integrationOrder
use FEM_Zoo, only: &
FEM_Zoo_nQuadrature, &
FEM_Zoo_QuadraturePoints, &
FEM_Zoo_QuadratureWeights
implicit none
type(tFieldBC), intent(in) :: fieldBC
DM :: mech_mesh
PetscFE :: mechFE
PetscQuadrature :: mechQuad, functional
PetscDS :: mechDS
PetscDualSpace :: mechDualSpace
DMLabel :: BCLabel
PetscInt, allocatable, target :: numComp(:), numDoF(:), bcField(:)
PetscInt, pointer :: pNumComp(:), pNumDof(:), pBcField(:), pBcPoint(:)
PetscInt :: numBC, bcSize
IS :: bcPoint
IS, allocatable, target :: bcComps(:), bcPoints(:)
IS, pointer :: pBcComps(:), pBcPoints(:)
PetscSection :: section
PetscInt :: field, faceSet, topologDim, nNodalPoints
PetscReal, pointer :: qPointsP(:), qWeightsP(:), &
nodalPointsP(:), nodalWeightsP(:)
PetscReal, allocatable, target :: nodalPoints(:), nodalWeights(:)
PetscScalar, pointer :: px_scal(:)
PetscScalar, allocatable, target :: x_scal(:)
PetscReal :: detJ
PetscReal, allocatable, target :: v0(:), cellJ(:), invcellJ(:), cellJMat(:,:)
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
PetscInt :: cellStart, cellEnd, cell, basis
character(len=7) :: prefix = 'mechFE_'
PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- FEM_mech init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
!--------------------------------------------------------------------------------------------------
! Setup FEM mech mesh
call DMClone(geomMesh,mech_mesh,ierr); CHKERRQ(ierr)
call DMGetDimension(mech_mesh,dimPlex,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! Setup FEM mech discretization
allocate(qPoints(dimPlex*FEM_Zoo_nQuadrature(dimPlex,integrationOrder)))
allocate(qWeights(FEM_Zoo_nQuadrature(dimPlex,integrationOrder)))
qPoints = FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p
qWeights = FEM_Zoo_QuadratureWeights(dimPlex,integrationOrder)%p
nQuadrature = FEM_Zoo_nQuadrature(dimPlex,integrationOrder)
qPointsP => qPoints
qWeightsP => qWeights
call PetscQuadratureCreate(PETSC_COMM_SELF,mechQuad,ierr); CHKERRQ(ierr)
call PetscQuadratureSetData(mechQuad,dimPlex,nQuadrature,qPointsP,qWeightsP,ierr)
CHKERRQ(ierr)
call PetscFECreateDefault(mech_mesh,dimPlex,dimPlex,PETSC_TRUE,prefix, &
integrationOrder,mechFE,ierr); CHKERRQ(ierr)
call PetscFESetQuadrature(mechFE,mechQuad,ierr); CHKERRQ(ierr)
call PetscFEGetDimension(mechFE,nBasis,ierr); CHKERRQ(ierr)
call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr)
call PetscDSAddDiscretization(mechDS,mechFE,ierr); CHKERRQ(ierr)
call PetscDSGetTotalDimension(mechDS,cellDof,ierr); CHKERRQ(ierr)
call PetscFEDestroy(mechFE,ierr); CHKERRQ(ierr)
call PetscQuadratureDestroy(mechQuad,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! Setup FEM mech boundary conditions
call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr)
call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr)
call DMGetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr)
allocate(numComp(1), source=dimPlex); pNumComp => numComp
allocate(numDof(dimPlex+1), source = 0); pNumDof => numDof
do topologDim = 0, dimPlex
call DMPlexGetDepthStratum(mech_mesh,topologDim,cellStart,cellEnd,ierr)
CHKERRQ(ierr)
call PetscSectionGetDof(section,cellStart,numDof(topologDim+1),ierr)
CHKERRQ(ierr)
enddo
numBC = 0
do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries
if (fieldBC%componentBC(field)%Mask(faceSet)) numBC = numBC + 1
enddo; enddo
allocate(bcField(numBC), source=0); pBcField => bcField
allocate(bcComps(numBC)); pBcComps => bcComps
allocate(bcPoints(numBC)); pBcPoints => bcPoints
numBC = 0
do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries
if (fieldBC%componentBC(field)%Mask(faceSet)) then
numBC = numBC + 1
call ISCreateGeneral(PETSC_COMM_WORLD,1,[field-1],PETSC_COPY_VALUES,bcComps(numBC),ierr)
CHKERRQ(ierr)
call DMGetStratumSize(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcSize,ierr)
CHKERRQ(ierr)
if (bcSize > 0) then
call DMGetStratumIS(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcPoint,ierr)
CHKERRQ(ierr)
call ISGetIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr)
call ISCreateGeneral(PETSC_COMM_WORLD,bcSize,pBcPoint,PETSC_COPY_VALUES,bcPoints(numBC),ierr)
CHKERRQ(ierr)
call ISRestoreIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr)
call ISDestroy(bcPoint,ierr); CHKERRQ(ierr)
else
call ISCreateGeneral(PETSC_COMM_WORLD,0,[0],PETSC_COPY_VALUES,bcPoints(numBC),ierr)
CHKERRQ(ierr)
endif
endif
enddo; enddo
call DMPlexCreateSection(mech_mesh,dimPlex,1,pNumComp,pNumDof, &
numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS, &
section,ierr)
CHKERRQ(ierr)
call DMSetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr)
do faceSet = 1, numBC
call ISDestroy(bcPoints(faceSet),ierr); CHKERRQ(ierr)
enddo
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
call SNESCreate(PETSC_COMM_WORLD,mech_snes,ierr);CHKERRQ(ierr)
call SNESSetOptionsPrefix(mech_snes,'mech_',ierr);CHKERRQ(ierr)
call SNESSetDM(mech_snes,mech_mesh,ierr); CHKERRQ(ierr) !< set the mesh for non-linear solver
call DMCreateGlobalVector(mech_mesh,solution ,ierr); CHKERRQ(ierr) !< locally owned displacement Dofs
call DMCreateGlobalVector(mech_mesh,solution_rate ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step
call DMCreateLocalVector (mech_mesh,solution_local ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step
call DMSNESSetFunctionLocal(mech_mesh,FEM_mech_formResidual,PETSC_NULL_VEC,ierr) !< function to evaluate residual forces
CHKERRQ(ierr)
call DMSNESSetJacobianLocal(mech_mesh,FEM_mech_formJacobian,PETSC_NULL_VEC,ierr) !< function to evaluate stiffness matrix
CHKERRQ(ierr)
call SNESSetMaxLinearSolveFailures(mech_snes, huge(1), ierr); CHKERRQ(ierr) !< ignore linear solve failures
call SNESSetConvergenceTest(mech_snes,FEM_mech_converged,PETSC_NULL_VEC,PETSC_NULL_FUNCTION,ierr)
CHKERRQ(ierr)
call SNESSetTolerances(mech_snes,1.0,0.0,0.0,itmax,itmax,ierr)
CHKERRQ(ierr)
call SNESSetFromOptions(mech_snes,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! init fields
call VecSet(solution ,0.0,ierr); CHKERRQ(ierr)
call VecSet(solution_rate ,0.0,ierr); CHKERRQ(ierr)
allocate(x_scal(cellDof))
allocate(nodalPoints (dimPlex))
allocate(nodalWeights(1))
nodalPointsP => nodalPoints
nodalWeightsP => nodalWeights
allocate(v0(dimPlex))
allocate(cellJ(dimPlex*dimPlex))
allocate(invcellJ(dimPlex*dimPlex))
allocate(cellJMat(dimPlex,dimPlex))
pV0 => v0
pCellJ => cellJ
pInvcellJ => invcellJ
call DMGetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr)
call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr)
call PetscDSGetDiscretization(mechDS,0,mechFE,ierr)
CHKERRQ(ierr)
call PetscFEGetDualSpace(mechFE,mechDualSpace,ierr); CHKERRQ(ierr)
call DMPlexGetHeightStratum(mech_mesh,0,cellStart,cellEnd,ierr)
CHKERRQ(ierr)
do cell = cellStart, cellEnd-1 !< loop over all elements
x_scal = 0.0
call DMPlexComputeCellGeometryAffineFEM(mech_mesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr)
CHKERRQ(ierr)
cellJMat = reshape(pCellJ,shape=[dimPlex,dimPlex])
do basis = 0, nBasis-1
call PetscDualSpaceGetFunctional(mechDualSpace,basis,functional,ierr)
CHKERRQ(ierr)
call PetscQuadratureGetData(functional,dimPlex,nNodalPoints,nodalPointsP,nodalWeightsP,ierr)
CHKERRQ(ierr)
x_scal(basis*dimPlex+1:(basis+1)*dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0)
enddo
px_scal => x_scal
call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,INSERT_ALL_VALUES,ierr)
CHKERRQ(ierr)
enddo
end subroutine FEM_mech_init
!--------------------------------------------------------------------------------------------------
!> @brief solution for the FEM load step
!--------------------------------------------------------------------------------------------------
type(tSolutionState) function FEM_mech_solution( &
incInfoIn,timeinc,timeinc_old,fieldBC)
use numerics, only: &
itmax
use FEsolving, only: &
terminallyIll
implicit none
!--------------------------------------------------------------------------------------------------
! input data for solution
real(pReal), intent(in) :: &
timeinc, & !< increment in time for current solution
timeinc_old !< increment in time of last increment
type(tFieldBC), intent(in) :: &
fieldBC
character(len=*), intent(in) :: &
incInfoIn
!--------------------------------------------------------------------------------------------------
!
PetscErrorCode :: ierr
SNESConvergedReason :: reason
incInfo = incInfoIn
FEM_mech_solution%converged =.false.
!--------------------------------------------------------------------------------------------------
! set module wide availabe data
params%timeinc = timeinc
params%timeincOld = timeinc_old
params%fieldBC = fieldBC
call SNESSolve(mech_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) ! solve mech_snes based on solution guess (result in solution)
call SNESGetConvergedReason(mech_snes,reason,ierr); CHKERRQ(ierr) ! solution converged?
terminallyIll = .false.
if (reason < 1) then ! 0: still iterating (will not occur), negative -> convergence error
FEM_mech_solution%converged = .false.
FEM_mech_solution%iterationsNeeded = itmax
else ! >= 1 proper convergence (or terminally ill)
FEM_mech_solution%converged = .true.
call SNESGetIterationNumber(mech_snes,FEM_mech_solution%iterationsNeeded,ierr)
CHKERRQ(ierr)
endif
write(6,'(/,a)') ' ==========================================================================='
flush(6)
end function FEM_mech_solution
!--------------------------------------------------------------------------------------------------
!> @brief forms the FEM residual vector
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
use numerics, only: &
BBarStabilisation
use FEM_utilities, only: &
utilities_projectBCValues, &
utilities_constitutiveResponse
use homogenization, only: &
materialpoint_F, &
materialpoint_P
use math, only: &
math_det33, &
math_inv33
use FEsolving, only: &
terminallyIll
implicit none
DM :: dm_local
PetscDS :: prob
Vec :: x_local, f_local, xx_local
PetscSection :: section
PetscScalar, dimension(:), pointer :: x_scal, pf_scal
PetscScalar, target :: f_scal(cellDof)
PetscReal :: detJ, IcellJMat(dimPlex,dimPlex)
PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), &
invcellJ(dimPlex*dimPlex)
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
PetscReal, pointer :: basisField(:), basisFieldDer(:)
PetscInt :: cellStart, cellEnd, cell, field, face, &
qPt, basis, comp, cidx
PetscReal :: detFAvg
PetscReal :: BMat(dimPlex*dimPlex,cellDof)
PetscObject :: dummy
PetscInt :: bcSize
IS :: bcPoints
PetscErrorCode :: ierr
pV0 => v0
pCellJ => cellJ
pInvcellJ => invcellJ
call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr)
call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr)
call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr)
CHKERRQ(ierr)
call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr); CHKERRQ(ierr)
call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
call VecWAXPY(x_local,1.0,xx_local,solution_local,ierr); CHKERRQ(ierr)
do field = 1, dimPlex; do face = 1, mesh_Nboundaries
if (params%fieldBC%componentBC(field)%Mask(face)) then
call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,ierr)
if (bcSize > 0) then
call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,ierr)
CHKERRQ(ierr)
call utilities_projectBCValues(x_local,section,0,field-1,bcPoints, &
0.0,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
call ISDestroy(bcPoints,ierr); CHKERRQ(ierr)
endif
endif
enddo; enddo
!--------------------------------------------------------------------------------------------------
! evaluate field derivatives
do cell = cellStart, cellEnd-1 !< loop over all elements
call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr) !< get Dofs belonging to element
CHKERRQ(ierr)
call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr)
CHKERRQ(ierr)
IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
do qPt = 0, nQuadrature-1
BMat = 0.0
do basis = 0, nBasis-1
do comp = 0, dimPlex-1
cidx = basis*dimPlex+comp
BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = &
matmul(IcellJMat,basisFieldDer((qPt*nBasis*dimPlex+cidx )*dimPlex+1: &
(qPt*nBasis*dimPlex+cidx+1)*dimPlex ))
enddo
enddo
materialpoint_F(1:dimPlex,1:dimPlex,qPt+1,cell+1) = &
reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1])
enddo
if (BBarStabilisation) then
detFAvg = math_det33(sum(materialpoint_F(1:3,1:3,1:nQuadrature,cell+1),dim=3)/real(nQuadrature))
do qPt = 1, nQuadrature
materialpoint_F(1:dimPlex,1:dimPlex,qPt,cell+1) = &
materialpoint_F(1:dimPlex,1:dimPlex,qPt,cell+1)* &
(detFAvg/math_det33(materialpoint_F(1:3,1:3,qPt,cell+1)))**(1.0/real(dimPlex))
enddo
endif
call DMPlexVecRestoreClosure(dm_local,section,x_local,cell,x_scal,ierr)
CHKERRQ(ierr)
enddo
!--------------------------------------------------------------------------------------------------
! evaluate constitutive response
call Utilities_constitutiveResponse(params%timeinc,P_av,ForwardData)
call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr)
ForwardData = .false.
!--------------------------------------------------------------------------------------------------
! integrating residual
do cell = cellStart, cellEnd-1 !< loop over all elements
call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr) !< get Dofs belonging to element
CHKERRQ(ierr)
call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr)
CHKERRQ(ierr)
IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
f_scal = 0.0
do qPt = 0, nQuadrature-1
BMat = 0.0
do basis = 0, nBasis-1
do comp = 0, dimPlex-1
cidx = basis*dimPlex+comp
BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = &
matmul(IcellJMat,basisFieldDer((qPt*nBasis*dimPlex+cidx )*dimPlex+1: &
(qPt*nBasis*dimPlex+cidx+1)*dimPlex ))
enddo
enddo
f_scal = f_scal + &
matmul(transpose(BMat), &
reshape(transpose(materialpoint_P(1:dimPlex,1:dimPlex,qPt+1,cell+1)), &
shape=[dimPlex*dimPlex]))*qWeights(qPt+1)
enddo
f_scal = f_scal*abs(detJ)
pf_scal => f_scal
call DMPlexVecSetClosure(dm_local,section,f_local,cell,pf_scal,ADD_VALUES,ierr)
CHKERRQ(ierr)
call DMPlexVecRestoreClosure(dm_local,section,x_local,cell,x_scal,ierr)
CHKERRQ(ierr)
enddo
call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
end subroutine FEM_mech_formResidual
!--------------------------------------------------------------------------------------------------
!> @brief forms the FEM stiffness matrix
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
use numerics, only: &
BBarStabilisation
use homogenization, only: &
materialpoint_dPdF, &
materialpoint_F
use math, only: &
math_inv33, &
math_identity2nd, &
math_det33
use FEM_utilities, only: &
utilities_projectBCValues
implicit none
DM :: dm_local
PetscDS :: prob
Vec :: x_local, xx_local
Mat :: Jac_pre, Jac
PetscSection :: section, gSection
PetscReal :: detJ, IcellJMat(dimPlex,dimPlex)
PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), &
invcellJ(dimPlex*dimPlex)
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
PetscReal, dimension(:), pointer :: basisField, basisFieldDer
PetscInt :: cellStart, cellEnd, cell, field, face, &
qPt, basis, comp, cidx
PetscScalar, target :: K_e (cellDof,cellDof), &
K_eA (cellDof,cellDof), &
K_eB (cellDof,cellDof), &
K_eVec(cellDof*cellDof)
PetscReal :: BMat (dimPlex*dimPlex,cellDof), &
BMatAvg(dimPlex*dimPlex,cellDof), &
MatA (dimPlex*dimPlex,cellDof), &
MatB (1 ,cellDof)
PetscScalar, dimension(:), pointer :: pK_e, x_scal
PetscReal, dimension(3,3) :: F = math_I3, FAvg, FInv
PetscObject :: dummy
PetscInt :: bcSize
IS :: bcPoints
PetscErrorCode :: ierr
pV0 => v0
pCellJ => cellJ
pInvcellJ => invcellJ
call MatSetOption(Jac,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE,ierr); CHKERRQ(ierr)
call MatSetOption(Jac,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE,ierr); CHKERRQ(ierr)
call MatZeroEntries(Jac,ierr); CHKERRQ(ierr)
call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr)
call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr)
call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr)
call DMGetDefaultGlobalSection(dm_local,gSection,ierr); CHKERRQ(ierr)
call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
call VecWAXPY(x_local,1.0,xx_local,solution_local,ierr); CHKERRQ(ierr)
do field = 1, dimPlex; do face = 1, mesh_Nboundaries
if (params%fieldBC%componentBC(field)%Mask(face)) then
call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,ierr)
if (bcSize > 0) then
call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,ierr)
CHKERRQ(ierr)
call utilities_projectBCValues(x_local,section,0,field-1,bcPoints, &
0.0,params%fieldBC%componentBC(field)%Value(face),params%timeinc)
call ISDestroy(bcPoints,ierr); CHKERRQ(ierr)
endif
endif
enddo; enddo
call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr); CHKERRQ(ierr)
do cell = cellStart, cellEnd-1 !< loop over all elements
call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr) !< get Dofs belonging to element
CHKERRQ(ierr)
call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr)
CHKERRQ(ierr)
IcellJMat = reshape(pInvcellJ, shape = [dimPlex,dimPlex])
K_eA = 0.0
K_eB = 0.0
MatB = 0.0
FAvg = 0.0
BMatAvg = 0.0
do qPt = 0, nQuadrature-1
BMat = 0.0
do basis = 0, nBasis-1
do comp = 0, dimPlex-1
cidx = basis*dimPlex+comp
BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = &
matmul(IcellJMat,basisFieldDer((qPt*nBasis*dimPlex+cidx )*dimPlex+1: &
(qPt*nBasis*dimPlex+cidx+1)*dimPlex ))
enddo
enddo
MatA = matmul(reshape(reshape(materialpoint_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,qPt+1,cell+1), &
shape=[dimPlex,dimPlex,dimPlex,dimPlex], order=[2,1,4,3]), &
shape=[dimPlex*dimPlex,dimPlex*dimPlex]),BMat)*qWeights(qPt+1)
if (BBarStabilisation) then
F(1:dimPlex,1:dimPlex) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex])
FInv = math_inv33(F)
K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0/real(dimPlex))
K_eB = K_eB - &
matmul(transpose(matmul(reshape(materialpoint_F(1:dimPlex,1:dimPlex,qPt+1,cell+1), &
shape=[dimPlex*dimPlex,1]), &
matmul(reshape(FInv(1:dimPlex,1:dimPlex), &
shape=[1,dimPlex*dimPlex],order=[2,1]),BMat))),MatA)
MatB = MatB + &
matmul(reshape(materialpoint_F(1:dimPlex,1:dimPlex,qPt+1,cell+1),shape=[1,dimPlex*dimPlex]),MatA)
FAvg = FAvg + F
BMatAvg = BMatAvg + BMat
else
K_eA = K_eA + matmul(transpose(BMat),MatA)
endif
enddo
if (BBarStabilisation) then
FInv = math_inv33(FAvg)
K_e = K_eA*math_det33(FAvg/real(nQuadrature))**(1.0/real(dimPlex)) + &
(matmul(matmul(transpose(BMatAvg), &
reshape(FInv(1:dimPlex,1:dimPlex),shape=[dimPlex*dimPlex,1],order=[2,1])),MatB) + &
K_eB)/real(dimPlex)
else
K_e = K_eA
endif
K_e = K_e + eps*math_identity2nd(cellDof)
K_eVec = reshape(K_e, [cellDof*cellDof])*abs(detJ)
pK_e => K_eVec
call DMPlexMatSetClosure(dm_local,section,gSection,Jac,cell,pK_e,ADD_VALUES,ierr)
CHKERRQ(ierr)
call DMPlexVecRestoreClosure(dm_local,section,x_local,cell,x_scal,ierr)
CHKERRQ(ierr)
enddo
call MatAssemblyBegin(Jac,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr)
call MatAssemblyEnd(Jac,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr)
call MatAssemblyBegin(Jac_pre,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr)
call MatAssemblyEnd(Jac_pre,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr)
call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! apply boundary conditions
!call DMPlexCreateRigidBody(dm_local,matnull,ierr); CHKERRQ(ierr) MD: linker error
call MatSetNullSpace(Jac,matnull,ierr); CHKERRQ(ierr)
call MatSetNearNullSpace(Jac,matnull,ierr); CHKERRQ(ierr)
call MatNullSpaceDestroy(matnull,ierr); CHKERRQ(ierr)
end subroutine FEM_mech_formJacobian
!--------------------------------------------------------------------------------------------------
!> @brief forwarding routine
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_forward(guess,timeinc,timeinc_old,fieldBC)
use FEM_utilities, only: &
cutBack
use homogenization, only: &
materialpoint_F0, &
materialpoint_F
use FEM_utilities, only: &
utilities_projectBCValues
implicit none
type(tFieldBC), intent(in) :: &
fieldBC
real(pReal), intent(in) :: &
timeinc_old, &
timeinc
logical, intent(in) :: &
guess
PetscInt :: field, face
DM :: dm_local
Vec :: x_local
PetscSection :: section
PetscInt :: bcSize
IS :: bcPoints
PetscErrorCode :: ierr
!--------------------------------------------------------------------------------------------------
! forward last inc
if (guess .and. .not. cutBack) then
ForwardData = .True.
materialpoint_F0 = materialpoint_F
call SNESGetDM(mech_snes,dm_local,ierr); CHKERRQ(ierr) !< retrieve mesh info from mech_snes into dm_local
call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr)
call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
call VecSet(x_local,0.0,ierr); CHKERRQ(ierr)
call DMGlobalToLocalBegin(dm_local,solution,INSERT_VALUES,x_local,ierr) !< retrieve my partition of global solution vector
CHKERRQ(ierr)
call DMGlobalToLocalEnd(dm_local,solution,INSERT_VALUES,x_local,ierr)
CHKERRQ(ierr)
call VecAXPY(solution_local,1.0,x_local,ierr); CHKERRQ(ierr)
do field = 1, dimPlex; do face = 1, mesh_Nboundaries
if (fieldBC%componentBC(field)%Mask(face)) then
call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,ierr)
if (bcSize > 0) then
call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,ierr)
CHKERRQ(ierr)
call utilities_projectBCValues(solution_local,section,0,field-1,bcPoints, &
0.0,fieldBC%componentBC(field)%Value(face),timeinc_old)
call ISDestroy(bcPoints,ierr); CHKERRQ(ierr)
endif
endif
enddo; enddo
call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! update rate and forward last inc
call VecCopy(solution,solution_rate,ierr); CHKERRQ(ierr)
call VecScale(solution_rate,1.0/timeinc_old,ierr); CHKERRQ(ierr)
endif
call VecCopy(solution_rate,solution,ierr); CHKERRQ(ierr)
call VecScale(solution,timeinc,ierr); CHKERRQ(ierr)
end subroutine FEM_mech_forward
!--------------------------------------------------------------------------------------------------
!> @brief reporting
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr)
use numerics, only: &
err_struct_tolAbs, &
err_struct_tolRel
use IO, only: &
IO_intOut
use FEsolving, only: &
terminallyIll
implicit none
SNES :: snes_local
PetscInt :: PETScIter
PetscReal :: xnorm,snorm,fnorm,divTol
SNESConvergedReason :: reason
PetscObject :: dummy
PetscErrorCode :: ierr
!--------------------------------------------------------------------------------------------------
! report
divTol = max(maxval(abs(P_av(1:dimPlex,1:dimPlex)))*err_struct_tolRel,err_struct_tolAbs)
call SNESConvergedDefault(snes_local,PETScIter,xnorm,snorm,fnorm/divTol,reason,dummy,ierr)
CHKERRQ(ierr)
if (terminallyIll) reason = SNES_DIVERGED_FUNCTION_DOMAIN
if (worldrank == 0) then
write(6,'(1/,1x,a,a,i0,a,i0,f0.3)') trim(incInfo), &
' @ Iteration ',PETScIter,' mechanical residual norm = ', &
int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol)
write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',&
transpose(P_av)*1.e-6_pReal
flush(6)
endif
end subroutine FEM_mech_converged
!--------------------------------------------------------------------------------------------------
!> @brief destroy routine
!--------------------------------------------------------------------------------------------------
subroutine FEM_mech_destroy()
implicit none
PetscErrorCode :: ierr
call VecDestroy(solution,ierr); CHKERRQ(ierr)
call VecDestroy(solution_rate,ierr); CHKERRQ(ierr)
call SNESDestroy(mech_snes,ierr); CHKERRQ(ierr)
end subroutine FEM_mech_destroy
end module FEM_mech

751
src/FEM_utilities.f90 Normal file
View File

@ -0,0 +1,751 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Utilities used by the FEM solver
!--------------------------------------------------------------------------------------------------
module FEM_utilities
#include <petsc/finclude/petsc.h>
use prec, only: pReal, pInt
use PETScdmda
use PETScis
implicit none
private
!--------------------------------------------------------------------------------------------------
!
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
integer(pInt), public, parameter :: maxFields = 6_pInt
integer(pInt), public :: nActiveFields = 0_pInt
!--------------------------------------------------------------------------------------------------
! grid related information information
real(pReal), public :: wgt !< weighting factor 1/Nelems
real(pReal), public :: wgtDof !< weighting factor 1/Nelems
real(pReal), public :: C_volAvg(3,3,3,3)
!--------------------------------------------------------------------------------------------------
! output data
PetscViewer, public :: resUnit
Vec, public :: coordinatesVec
Vec, allocatable, public :: homogenizationResultsVec(:), &
crystalliteResultsVec(:,:), &
phaseResultsVec(:,:)
!--------------------------------------------------------------------------------------------------
! field labels information
character(len=*), parameter, public :: &
FIELD_MECH_label = 'mechanical', &
FIELD_THERMAL_label = 'thermal', &
FIELD_DAMAGE_label = 'damage', &
FIELD_SOLUTE_label = 'solute', &
FIELD_MGTWIN_label = 'mgtwin'
enum, bind(c)
enumerator :: FIELD_UNDEFINED_ID, &
FIELD_MECH_ID, &
FIELD_THERMAL_ID, &
FIELD_DAMAGE_ID, &
FIELD_SOLUTE_ID, &
FIELD_MGTWIN_ID
end enum
enum, bind(c)
enumerator :: COMPONENT_UNDEFINED_ID, &
COMPONENT_MECH_X_ID, &
COMPONENT_MECH_Y_ID, &
COMPONENT_MECH_Z_ID, &
COMPONENT_THERMAL_T_ID, &
COMPONENT_DAMAGE_PHI_ID, &
COMPONENT_SOLUTE_CV_ID, &
COMPONENT_SOLUTE_CVPOT_ID, &
COMPONENT_SOLUTE_CH_ID, &
COMPONENT_SOLUTE_CHPOT_ID, &
COMPONENT_SOLUTE_CVaH_ID, &
COMPONENT_SOLUTE_CVaHPOT_ID, &
COMPONENT_MGTWIN_PHI_ID
end enum
!--------------------------------------------------------------------------------------------------
! variables controlling debugging
logical, private :: &
debugGeneral, & !< general debugging of FEM solver
debugRotation, & !< also printing out results in lab frame
debugPETSc !< use some in debug defined options for more verbose PETSc solution
!--------------------------------------------------------------------------------------------------
! derived types
type, public :: tSolutionState !< return type of solution from FEM solver variants
logical :: converged = .true.
logical :: stagConverged = .true.
logical :: regrid = .false.
integer(pInt) :: iterationsNeeded = 0_pInt
end type tSolutionState
type, public :: tComponentBC
integer(kind(COMPONENT_UNDEFINED_ID)) :: ID
real(pReal), allocatable :: Value(:)
logical, allocatable :: Mask(:)
end type tComponentBC
type, public :: tFieldBC
integer(kind(FIELD_UNDEFINED_ID)) :: ID
integer(pInt) :: nComponents = 0_pInt
type(tComponentBC), allocatable :: componentBC(:)
end type tFieldBC
type, public :: tLoadCase
real(pReal) :: time = 0.0_pReal !< length of increment
integer(pInt) :: incs = 0_pInt, & !< number of increments
outputfrequency = 1_pInt, & !< frequency of result writes
restartfrequency = 0_pInt, & !< frequency of restart writes
logscale = 0_pInt !< linear/logarithmic time inc flag
logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase
integer(pInt), allocatable :: faceID(:)
type(tFieldBC), allocatable :: fieldBC(:)
end type tLoadCase
type, public :: tFEMInterpolation
integer(pInt) :: n
real(pReal), dimension(:,:) , allocatable :: shapeFunc, shapeDerivReal, geomShapeDerivIso
real(pReal), dimension(:,:,:), allocatable :: shapeDerivIso
end type tFEMInterpolation
type, public :: tQuadrature
integer(pInt) :: n
real(pReal), dimension(:) , allocatable :: Weights
real(pReal), dimension(:,:), allocatable :: Points
end type tQuadrature
public :: &
utilities_init, &
utilities_constitutiveResponse, &
utilities_indexBoundaryDofs, &
utilities_projectBCValues, &
utilities_indexActiveSet, &
utilities_destroy, &
FIELD_MECH_ID, &
FIELD_THERMAL_ID, &
FIELD_DAMAGE_ID, &
FIELD_SOLUTE_ID, &
FIELD_MGTWIN_ID, &
COMPONENT_MECH_X_ID, &
COMPONENT_MECH_Y_ID, &
COMPONENT_MECH_Z_ID, &
COMPONENT_THERMAL_T_ID, &
COMPONENT_DAMAGE_PHI_ID, &
COMPONENT_SOLUTE_CV_ID, &
COMPONENT_SOLUTE_CVPOT_ID, &
COMPONENT_SOLUTE_CH_ID, &
COMPONENT_SOLUTE_CHPOT_ID, &
COMPONENT_SOLUTE_CVaH_ID, &
COMPONENT_SOLUTE_CVaHPOT_ID, &
COMPONENT_MGTWIN_PHI_ID
external :: &
PetscOptionsInsertString, &
PetscObjectSetName, &
DMPlexGetHeightStratum, &
DMGetLabelIdIS, &
DMPlexGetChart, &
DMPlexLabelComplete, &
PetscViewerHDF5Open, &
PetscViewerHDF5PushGroup, &
PetscViewerHDF5PopGroup, &
PetscViewerDestroy
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields, sets debug flags
!--------------------------------------------------------------------------------------------------
subroutine utilities_init()
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment)
use DAMASK_interface, only: &
getSolverJobName
use IO, only: &
IO_error, &
IO_warning, &
IO_timeStamp, &
IO_open_file
use numerics, only: &
integrationOrder, &
worldsize, &
worldrank, &
petsc_defaultOptions, &
petsc_options
use debug, only: &
debug_level, &
debug_SPECTRAL, &
debug_LEVELBASIC, &
debug_SPECTRALPETSC, &
debug_SPECTRALROTATION
use debug, only: &
PETSCDEBUG
use math ! must use the whole module for use of FFTW
use mesh, only: &
mesh_NcpElemsGlobal, &
mesh_maxNips, &
geomMesh
use material, only: &
material_homog
implicit none
character(len=1024) :: petsc_optionsPhysics, grainStr
integer(pInt) :: dimPlex
integer(pInt) :: headerID = 205_pInt
PetscInt, dimension(:), pointer :: points
PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:), mappingCells(:)
PetscInt :: cellStart, cellEnd, cell, ip, dim, ctr, qPt
PetscInt, allocatable :: connectivity(:,:)
Vec :: connectivityVec
PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
!--------------------------------------------------------------------------------------------------
! set debugging parameters
debugGeneral = iand(debug_level(debug_SPECTRAL),debug_LEVELBASIC) /= 0
debugRotation = iand(debug_level(debug_SPECTRAL),debug_SPECTRALROTATION) /= 0
debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0
if(debugPETSc) write(6,'(3(/,a),/)') &
' Initializing PETSc with debug options: ', &
trim(PETScDebug), &
' add more using the PETSc_Options keyword in numerics.config '
flush(6)
call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr)
CHKERRQ(ierr)
if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
CHKERRQ(ierr)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr)
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr)
CHKERRQ(ierr)
!write(petsc_optionsPhysics,'(a,i0)') '-mechFE_petscspace_order ' , structOrder
call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsPhysics),ierr)
CHKERRQ(ierr)
wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal)
call PetscViewerHDF5Open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.h5', &
FILE_MODE_WRITE, resUnit, ierr); CHKERRQ(ierr)
call PetscViewerHDF5PushGroup(resUnit, '/', 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)
if (worldrank == 0_pInt) then
open(unit=headerID, file=trim(getSolverJobName())//'.header', &
form='FORMATTED', status='REPLACE')
write(headerID, '(a,i0)') 'dimension : ', dimPlex
write(headerID, '(a,i0)') 'number of nodes : ', sum(nOutputNodes)
write(headerID, '(a,i0)') 'number of cells : ', sum(nOutputCells)
endif
allocate(connectivity(2**dimPlex,nOutputCells(worldrank+1)))
call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr)
CHKERRQ(ierr)
ctr = 0
select case (integrationOrder)
case(1_pInt)
do cell = cellStart, cellEnd-1 !< loop over all elements
call DMPlexGetTransitiveClosure(geomMesh,cell,PETSC_TRUE,points,ierr)
CHKERRQ(ierr)
if (dimPlex == 2) then
connectivity(:,ctr+1) = [points( 9), points(11), points(13), points(13)] - nEntities(dimPlex+1)
ctr = ctr + 1
else
connectivity(:,ctr+1) = [points(23), points(25), points(27), points(27), &
points(29), points(29), points(29), points(29)] - nEntities(dimPlex+1)
ctr = ctr + 1
endif
enddo
case(2_pInt)
do cell = cellStart, cellEnd-1 !< loop over all elements
call DMPlexGetTransitiveClosure(geomMesh,cell,PETSC_TRUE,points,ierr)
CHKERRQ(ierr)
if (dimPlex == 2) then
connectivity(:,ctr+1) = [points(9 ), points(3), points(1), points(7)]
connectivity(:,ctr+2) = [points(11), points(5), points(1), points(3)]
connectivity(:,ctr+3) = [points(13), points(7), points(1), points(5)]
ctr = ctr + 3
else
connectivity(:,ctr+1) = [points(23), points(11), points(3), points(15), points(17), points(5), points(1), points(7)]
connectivity(:,ctr+2) = [points(25), points(13), points(3), points(11), points(19), points(9), points(1), points(5)]
connectivity(:,ctr+3) = [points(27), points(15), points(3), points(13), points(21), points(7), points(1), points(9)]
connectivity(:,ctr+4) = [points(29), points(17), points(7), points(21), points(19), points(5), points(1), points(9)]
ctr = ctr + 4_pInt
endif
enddo
case default
do cell = cellStart, cellEnd-1; do ip = 0, mesh_maxNips-1
connectivity(:,ctr+1) = cell*mesh_maxNips + ip
ctr = ctr + 1
enddo; enddo
end select
connectivity = connectivity + sum(nOutputNodes(1:worldrank))
call VecCreateMPI(PETSC_COMM_WORLD,dimPlex*nOutputNodes(worldrank+1),dimPlex*sum(nOutputNodes), &
coordinatesVec,ierr);CHKERRQ(ierr)
call PetscObjectSetName(coordinatesVec, 'NodalCoordinates',ierr)
call VecSetFromOptions(coordinatesVec, ierr); CHKERRQ(ierr)
!allocate(mappingCells(worldsize), source = 0)
!do homog = 1, material_Nhomogenization
! mappingCells = 0_pInt; mappingCells(worldrank+1) = homogOutput(homog)%sizeIpCells
! call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), &
! homogenizationResultsVec(homog),ierr);CHKERRQ(ierr)
! if (sum(mappingCells) > 0) then
! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, &
! connectivityVec,ierr);CHKERRQ(ierr)
! call PetscObjectSetName(connectivityVec,'mapping_'//trim(homogenization_name(homog)),ierr)
! CHKERRQ(ierr)
! call VecGetArrayF90(connectivityVec,results,ierr); CHKERRQ(ierr)
! results = 0.0_pReal; ctr = 1_pInt
! do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips
! if (material_homog(qPt,cell+1) == homog) then
! results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), &
! shape=[2**dimPlex]))
! ctr = ctr + 2**dimPlex
! endif
! enddo; enddo
! call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr)
! call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr)
! call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr)
! call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr)
! call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr)
! endif
!enddo
!do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains
! mappingCells = 0_pInt
! mappingCells(worldrank+1) = crystalliteOutput(cryst,grain)%sizeIpCells
! call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), &
! crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr)
! if (sum(mappingCells) > 0) then
! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, &
! connectivityVec,ierr);CHKERRQ(ierr)
! write(grainStr,'(a,i0)') 'Grain',grain
! call PetscObjectSetName(connectivityVec,'mapping_'// &
! trim(crystallite_name(cryst))//'_'// &
! trim(grainStr),ierr)
! CHKERRQ(ierr)
! call VecGetArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr)
! results = 0.0_pReal; ctr = 1_pInt
! do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips
! if (homogenization_Ngrains (mesh_element(3,cell+1)) >= grain .and. &
! microstructure_crystallite(mesh_element(4,cell+1)) == cryst) then
! results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), &
! shape=[2**dimPlex]))
! ctr = ctr + 2**dimPlex
! endif
! enddo; enddo
! call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr)
! call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr)
! call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr)
! call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr)
! call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr)
! endif
!enddo; enddo
!do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains
! mappingCells = 0_pInt
! mappingCells(worldrank+1) = phaseOutput(phase,grain)%sizeIpCells
! call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), &
! phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr)
! if (sum(mappingCells) > 0) then
! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, &
! connectivityVec,ierr);CHKERRQ(ierr)
! write(grainStr,'(a,i0)') 'Grain',grain
! call PetscObjectSetName(connectivityVec,&
! 'mapping_'//trim(phase_name(phase))//'_'// &
! trim(grainStr),ierr)
! CHKERRQ(ierr)
! call VecGetArrayF90(connectivityVec, results, ierr)
! CHKERRQ(ierr)
! results = 0.0_pReal; ctr = 1_pInt
! do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips
! if (material_phase(grain,qPt,cell+1) == phase) then
! results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), &
! shape=[2**dimPlex]))
! ctr = ctr + 2**dimPlex
! endif
! enddo; enddo
! call VecRestoreArrayF90(connectivityVec, results, ierr)
! CHKERRQ(ierr)
! call VecAssemblyBegin(connectivityVec, ierr);CHKERRQ(ierr)
! call VecAssemblyEnd (connectivityVec, ierr);CHKERRQ(ierr)
! call VecView(connectivityVec, resUnit, ierr);CHKERRQ(ierr)
! call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr)
! endif
!enddo; enddo
!if (worldrank == 0_pInt) then
! do homog = 1, material_Nhomogenization
! call VecGetSize(homogenizationResultsVec(homog),mappingCells(1),ierr)
! CHKERRQ(ierr)
! if (mappingCells(1) > 0) &
! write(headerID, '(a,i0)') 'number of homog_'// &
! trim(homogenization_name(homog))//'_'// &
! 'cells : ', mappingCells(1)
! enddo
! do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains
! call VecGetSize(crystalliteResultsVec(cryst,grain),mappingCells(1),ierr)
! CHKERRQ(ierr)
! write(grainStr,'(a,i0)') 'Grain',grain
! if (mappingCells(1) > 0) &
! write(headerID, '(a,i0)') 'number of cryst_'// &
! trim(crystallite_name(cryst))//'_'// &
! trim(grainStr)//'_'// &
! 'cells : ', mappingCells(1)
! enddo; enddo
! do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains
! call VecGetSize(phaseResultsVec(phase,grain),mappingCells(1),ierr)
! CHKERRQ(ierr)
! write(grainStr,'(a,i0)') 'Grain',grain
! if (mappingCells(1) > 0) &
! write(headerID, '(a,i0)') 'number of phase_'// &
! trim(phase_name(phase))//'_'//trim(grainStr)//'_'// &
! 'cells : ', mappingCells(1)
! enddo; enddo
! close(headerID)
!endif
end subroutine utilities_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates constitutive response
!--------------------------------------------------------------------------------------------------
subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
use debug, only: &
debug_reset, &
debug_info
use numerics, only: &
worldrank
use math, only: &
math_transpose33, &
math_rotate_forward33, &
math_det33
use FEsolving, only: &
restartWrite
use homogenization, only: &
materialpoint_F0, &
materialpoint_F, &
materialpoint_P, &
materialpoint_dPdF, &
materialpoint_stressAndItsTangent
use mesh, only: &
mesh_NcpElems
implicit none
real(pReal), intent(in) :: timeinc !< loading time
logical, intent(in) :: forwardData !< age results
real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress
logical :: &
age
integer(pInt) :: &
j
real(pReal) :: defgradDetMin, defgradDetMax, defgradDet
PetscErrorCode :: ierr
write(6,'(/,a)') ' ... evaluating constitutive response ......................................'
age = .False.
if (forwardData) then ! aging results
age = .True.
endif
if (cutBack) then ! restore saved variables
age = .False.
endif
call debug_reset()
!--------------------------------------------------------------------------------------------------
! calculate bounds of det(F) and report
if(debugGeneral) then
defgradDetMax = -huge(1.0_pReal)
defgradDetMin = +huge(1.0_pReal)
do j = 1_pInt, mesh_NcpElems
defgradDet = math_det33(materialpoint_F(1:3,1:3,1,j))
defgradDetMax = max(defgradDetMax,defgradDet)
defgradDetMin = min(defgradDetMin,defgradDet)
end do
write(6,'(a,1x,es11.4)') ' max determinant of deformation =', defgradDetMax
write(6,'(a,1x,es11.4)') ' min determinant of deformation =', defgradDetMin
flush(6)
endif
call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field
call debug_info()
restartWrite = .false. ! reset restartWrite status
cutBack = .false. ! reset cutBack status
P_av = sum(sum(materialpoint_P,dim=4),dim=3) * wgt ! average of P
C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt
call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD, ierr)
end subroutine utilities_constitutiveResponse
!--------------------------------------------------------------------------------------------------
!> @brief Create index sets of boundary dofs (in local and global numbering)
!--------------------------------------------------------------------------------------------------
subroutine utilities_indexBoundaryDofs(dm_local,nFaceSets,numFields,local2global,section,localIS,globalIS)
implicit none
DM :: dm_local
ISLocalToGlobalMapping :: local2global
PetscSection :: section
PetscInt :: nFaceSets, numFields, nDof
IS, dimension(nFaceSets,numFields) :: localIS, globalIS
PetscInt :: field, faceSet, point, dof, offset
PetscInt :: localSize, storageSize, ISSize
PetscInt, dimension(:) , allocatable :: localIndices
IS :: faceSetIS, BC_IS, dummyIS
PetscInt, dimension(:) , pointer :: pFaceSets, pBCvertex, pBCvertexlc
DMLabel :: BCLabel
PetscErrorCode :: ierr
call DMGetLabel(dm_local,'Face Sets',BCLabel,ierr); CHKERRQ(ierr)
call DMPlexLabelComplete(dm_local,BCLabel,ierr); CHKERRQ(ierr)
call PetscSectionGetStorageSize(section,storageSize,ierr); CHKERRQ(ierr)
call DMGetLabelIdIS(dm_local,'Face Sets',faceSetIS,ierr); CHKERRQ(ierr)
call ISGetIndicesF90(faceSetIS,pFaceSets,ierr); CHKERRQ(ierr)
allocate(localIndices (storageSize))
do faceSet = 1, nFaceSets
call DMGetStratumSize(dm_local,'Face Sets',pFaceSets(faceSet),ISSize,ierr)
CHKERRQ(ierr)
call DMGetStratumIS(dm_local,'Face Sets',pFaceSets(faceSet),BC_IS,ierr)
CHKERRQ(ierr)
if (ISSize > 0) call ISGetIndicesF90(BC_IS,pBCvertex,ierr)
do field = 1, numFields
localSize = 0
do point = 1, ISSize
call PetscSectionGetFieldDof(section,pBCvertex(point),field-1,nDof,ierr)
CHKERRQ(ierr)
call PetscSectionGetFieldOffset(section,pBCvertex(point),field-1,offset,ierr)
CHKERRQ(ierr)
do dof = 1, nDof
localSize = localSize + 1
localIndices(localSize) = offset + dof - 1
enddo
enddo
call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES, &
localIS(faceSet,field),ierr)
CHKERRQ(ierr)
call ISLocalToGlobalMappingApplyIS(local2global,localIS(faceSet,field), &
globalIS(faceSet,field),ierr)
CHKERRQ(ierr)
enddo
if (ISSize > 0) call ISRestoreIndicesF90(BC_IS,pBCvertex,ierr)
call ISDestroy(BC_IS,ierr); CHKERRQ(ierr)
enddo
call ISRestoreIndicesF90(faceSetIS,pFaceSets,ierr); CHKERRQ(ierr)
call ISDestroy(faceSetIS,ierr); CHKERRQ(ierr)
do faceSet = 1, nFaceSets; do field = 1, numFields
call ISGetSize(globalIS(faceSet,field),ISSize,ierr); CHKERRQ(ierr)
if (ISSize > 0) then
call ISGetIndicesF90(localIS(faceSet,field),pBCvertexlc,ierr); CHKERRQ(ierr)
call ISGetIndicesF90(globalIS(faceSet,field),pBCvertex,ierr); CHKERRQ(ierr)
endif
localSize = 0
do point = 1, ISSize
if (pBCvertex(point) >= 0) then
localSize = localSize + 1
localIndices(localSize) = pBCvertexlc(point)
endif
enddo
if (ISSize > 0) then
call ISRestoreIndicesF90(localIS(faceSet,field),pBCvertexlc,ierr); CHKERRQ(ierr)
call ISRestoreIndicesF90(globalIS(faceSet,field),pBCvertex,ierr); CHKERRQ(ierr)
endif
call ISDestroy(globalIS(faceSet,field),ierr); CHKERRQ(ierr)
call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES, &
globalIS(faceSet,field),ierr)
CHKERRQ(ierr)
if (ISSize > 0) then
call ISDuplicate(localIS(faceSet,field),dummyIS,ierr); CHKERRQ(ierr)
call ISDestroy(localIS(faceSet,field),ierr); CHKERRQ(ierr)
call ISDifference(dummyIS,globalIS(faceSet,field),localIS(faceSet,field),ierr)
CHKERRQ(ierr)
call ISDestroy(dummyIS,ierr); CHKERRQ(ierr)
endif
enddo; enddo
deallocate(localIndices)
end subroutine utilities_indexBoundaryDofs
!--------------------------------------------------------------------------------------------------
!> @brief Project BC values to local vector
!--------------------------------------------------------------------------------------------------
subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCValue,BCDotValue,timeinc)
implicit none
Vec :: localVec
PetscInt :: field, comp, nBcPoints, point, dof, numDof, numComp, offset
PetscSection :: section
IS :: bcPointsIS
PetscInt, pointer :: bcPoints(:)
PetscScalar, pointer :: localArray(:)
PetscScalar :: BCValue,BCDotValue,timeinc
PetscErrorCode :: ierr
call PetscSectionGetFieldComponents(section,field,numComp,ierr); CHKERRQ(ierr)
call ISGetSize(bcPointsIS,nBcPoints,ierr); CHKERRQ(ierr)
if (nBcPoints > 0) call ISGetIndicesF90(bcPointsIS,bcPoints,ierr)
call VecGetArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
do point = 1, nBcPoints
call PetscSectionGetFieldDof(section,bcPoints(point),field,numDof,ierr)
CHKERRQ(ierr)
call PetscSectionGetFieldOffset(section,bcPoints(point),field,offset,ierr)
CHKERRQ(ierr)
do dof = offset+comp+1, offset+numDof, numComp
localArray(dof) = localArray(dof) + BCValue + BCDotValue*timeinc
enddo
enddo
call VecRestoreArrayF90(localVec,localArray,ierr); CHKERRQ(ierr)
call VecAssemblyBegin(localVec, ierr); CHKERRQ(ierr)
call VecAssemblyEnd (localVec, ierr); CHKERRQ(ierr)
if (nBcPoints > 0) call ISRestoreIndicesF90(bcPointsIS,bcPoints,ierr)
end subroutine utilities_projectBCValues
!--------------------------------------------------------------------------------------------------
!> @brief Create index sets of boundary dofs (in local and global numbering)
!--------------------------------------------------------------------------------------------------
subroutine utilities_indexActiveSet(field,section,x_local,f_local,localIS,globalIS)
use mesh, only: &
geomMesh
implicit none
ISLocalToGlobalMapping :: local2global
PetscSection :: section
Vec :: x_local, f_local
PetscInt :: field
IS :: localIS, globalIS, dummyIS
PetscScalar, dimension(:) , pointer :: x_scal, f_scal
PetscInt :: ISSize
PetscInt :: chart, chartStart, chartEnd, nDof, dof, offset
PetscInt :: localSize
PetscInt, dimension(:) , allocatable :: localIndices
PetscInt, dimension(:) , pointer :: pBCvertex, pBCvertexlc
PetscErrorCode :: ierr
call DMGetLocalToGlobalMapping(geomMesh,local2global,ierr)
CHKERRQ(ierr)
call DMPlexGetChart(geomMesh,chartStart,chartEnd,ierr)
CHKERRQ(ierr)
call VecGetArrayF90(x_local,x_scal,ierr); CHKERRQ(ierr)
call VecGetArrayF90(f_local,f_scal,ierr); CHKERRQ(ierr)
localSize = 0
do chart = chartStart, chartEnd-1
call PetscSectionGetFieldDof(section,chart,field-1,nDof,ierr); CHKERRQ(ierr)
call PetscSectionGetFieldOffset(section,chart,field-1,offset,ierr); CHKERRQ(ierr)
do dof = offset+1, offset+nDof
if (((x_scal(dof) < 1.0e-8) .and. (f_scal(dof) > 0.0)) .or. &
((x_scal(dof) > 1.0 - 1.0e-8) .and. (f_scal(dof) < 0.0))) localSize = localSize + 1
enddo
enddo
allocate(localIndices(localSize))
localSize = 0
do chart = chartStart, chartEnd-1
call PetscSectionGetFieldDof(section,chart,field-1,nDof,ierr); CHKERRQ(ierr)
call PetscSectionGetFieldOffset(section,chart,field-1,offset,ierr); CHKERRQ(ierr)
do dof = offset+1, offset+nDof
if (((x_scal(dof) < 1.0e-8) .and. (f_scal(dof) > 0.0)) .or. &
((x_scal(dof) > 1.0 - 1.0e-8) .and. (f_scal(dof) < 0.0))) then
localSize = localSize + 1
localIndices(localSize) = dof-1
endif
enddo
enddo
call VecRestoreArrayF90(x_local,x_scal,ierr); CHKERRQ(ierr)
call VecRestoreArrayF90(f_local,f_scal,ierr); CHKERRQ(ierr)
call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES,localIS,ierr)
CHKERRQ(ierr)
call ISLocalToGlobalMappingApplyIS(local2global,localIS,globalIS,ierr)
CHKERRQ(ierr)
call ISGetSize(globalIS,ISSize,ierr); CHKERRQ(ierr)
if (ISSize > 0) then
call ISGetIndicesF90(localIS,pBCvertexlc,ierr); CHKERRQ(ierr)
call ISGetIndicesF90(globalIS,pBCvertex,ierr); CHKERRQ(ierr)
endif
localSize = 0
do chart = 1, ISSize
if (pBCvertex(chart) >= 0) then
localSize = localSize + 1
localIndices(localSize) = pBCvertexlc(chart)
endif
enddo
if (ISSize > 0) then
call ISRestoreIndicesF90(localIS,pBCvertexlc,ierr); CHKERRQ(ierr)
call ISRestoreIndicesF90(globalIS,pBCvertex,ierr); CHKERRQ(ierr)
endif
call ISDestroy(globalIS,ierr); CHKERRQ(ierr)
call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES,globalIS,ierr)
CHKERRQ(ierr)
if (ISSize > 0) then
call ISDuplicate(localIS,dummyIS,ierr); CHKERRQ(ierr)
call ISDestroy(localIS,ierr); CHKERRQ(ierr)
call ISDifference(dummyIS,globalIS,localIS,ierr)
CHKERRQ(ierr)
call ISDestroy(dummyIS,ierr); CHKERRQ(ierr)
endif
deallocate(localIndices)
end subroutine utilities_indexActiveSet
!--------------------------------------------------------------------------------------------------
!> @brief cleans up
!--------------------------------------------------------------------------------------------------
subroutine utilities_destroy()
!use material, only: &
! homogenization_Ngrains
!implicit none
!PetscInt :: homog, cryst, grain, phase
!PetscErrorCode :: ierr
!call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr)
!call VecDestroy(coordinatesVec,ierr); CHKERRQ(ierr)
!do homog = 1, material_Nhomogenization
! call VecDestroy(homogenizationResultsVec(homog),ierr);CHKERRQ(ierr)
! do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_Ngrains(homog)
! call VecDestroy(crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr)
! enddo; enddo
! do phase = 1, material_Nphase; do grain = 1, homogenization_Ngrains(homog)
! call VecDestroy(phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr)
! enddo; enddo
!enddo
!call PetscViewerDestroy(resUnit, ierr); CHKERRQ(ierr)
end subroutine utilities_destroy
end module FEM_utilities

350
src/FEM_zoo.f90 Normal file
View File

@ -0,0 +1,350 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Interpolation data used by the FEM solver
!--------------------------------------------------------------------------------------------------
module FEM_Zoo
use prec, only: pReal, pInt, group_float
implicit none
private
integer(pInt), parameter, public:: &
maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary)
real(pReal), dimension(2,3), private, protected :: &
triangle = reshape([-1.0_pReal, -1.0_pReal, &
1.0_pReal, -1.0_pReal, &
-1.0_pReal, 1.0_pReal], shape=[2,3])
real(pReal), dimension(3,4), private, protected :: &
tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, &
1.0_pReal, -1.0_pReal, -1.0_pReal, &
-1.0_pReal, 1.0_pReal, -1.0_pReal, &
-1.0_pReal, -1.0_pReal, 1.0_pReal], shape=[3,4])
integer(pInt), dimension(3,maxOrder), public, protected :: &
FEM_Zoo_nQuadrature !< number of quadrature points for a given spatial dimension(1-3) and interpolation order(1-maxOrder)
type(group_float), dimension(3,maxOrder), public, protected :: &
FEM_Zoo_QuadratureWeights, & !< quadrature weights for each quadrature rule
FEM_Zoo_QuadraturePoints !< quadrature point coordinates (in simplical system) for each quadrature rule
public :: &
FEM_Zoo_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief initializes FEM interpolation data
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_timeStamp
implicit none
write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>'
write(6,'(a)') ' $Id: FEM_Zoo.f90 4354 2015-08-04 15:04:53Z MPIE\p.shanthraj $'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
!--------------------------------------------------------------------------------------------------
! 2D linear
FEM_Zoo_nQuadrature(2,1) = 1
allocate(FEM_Zoo_QuadratureWeights(2,1)%p(1))
allocate(FEM_Zoo_QuadraturePoints (2,1)%p(2))
FEM_Zoo_QuadratureWeights(2,1)%p(1) = 1.0_pReal
call FEM_Zoo_permutationStar3([1.0_pReal/3.0_pReal], &
FEM_Zoo_QuadraturePoints(2,1)%p(1:2))
!--------------------------------------------------------------------------------------------------
! 2D quadratic
FEM_Zoo_nQuadrature(2,2) = 3
allocate(FEM_Zoo_QuadratureWeights(2,2)%p(3))
allocate(FEM_Zoo_QuadraturePoints (2,2)%p(6))
FEM_Zoo_QuadratureWeights(2,2)%p(1:3) = 1.0_pReal/3.0_pReal
call FEM_Zoo_permutationStar21([1.0_pReal/6.0_pReal], &
FEM_Zoo_QuadraturePoints(2,2)%p(1:6))
!--------------------------------------------------------------------------------------------------
! 2D cubic
FEM_Zoo_nQuadrature(2,3) = 6
allocate(FEM_Zoo_QuadratureWeights(2,3)%p(6 ))
allocate(FEM_Zoo_QuadraturePoints (2,3)%p(12))
FEM_Zoo_QuadratureWeights(2,3)%p(1:3) = 0.22338158967801146570_pReal
call FEM_Zoo_permutationStar21([0.44594849091596488632_pReal], &
FEM_Zoo_QuadraturePoints(2,3)%p(1:6))
FEM_Zoo_QuadratureWeights(2,3)%p(4:6) = 0.10995174365532186764_pReal
call FEM_Zoo_permutationStar21([0.091576213509770743460_pReal], &
FEM_Zoo_QuadraturePoints(2,3)%p(7:12))
!--------------------------------------------------------------------------------------------------
! 2D quartic
FEM_Zoo_nQuadrature(2,4) = 12
allocate(FEM_Zoo_QuadratureWeights(2,4)%p(12))
allocate(FEM_Zoo_QuadraturePoints (2,4)%p(24))
FEM_Zoo_QuadratureWeights(2,4)%p(1:3) = 0.11678627572638_pReal
call FEM_Zoo_permutationStar21([0.24928674517091_pReal], &
FEM_Zoo_QuadraturePoints(2,4)%p(1:6))
FEM_Zoo_QuadratureWeights(2,4)%p(4:6) = 0.05084490637021_pReal
call FEM_Zoo_permutationStar21([0.06308901449150_pReal], &
FEM_Zoo_QuadraturePoints(2,4)%p(7:12))
FEM_Zoo_QuadratureWeights(2,4)%p(7:12) = 0.08285107561837_pReal
call FEM_Zoo_permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal], &
FEM_Zoo_QuadraturePoints(2,4)%p(13:24))
!--------------------------------------------------------------------------------------------------
! 2D order 5
FEM_Zoo_nQuadrature(2,5) = 16
allocate(FEM_Zoo_QuadratureWeights(2,5)%p(16))
allocate(FEM_Zoo_QuadraturePoints (2,5)%p(32))
FEM_Zoo_QuadratureWeights(2,5)%p(1 ) = 0.14431560767779_pReal
call FEM_Zoo_permutationStar3([0.33333333333333_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(1:2))
FEM_Zoo_QuadratureWeights(2,5)%p(2:4) = 0.09509163426728_pReal
call FEM_Zoo_permutationStar21([0.45929258829272_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(3:8))
FEM_Zoo_QuadratureWeights(2,5)%p(5:7) = 0.10321737053472_pReal
call FEM_Zoo_permutationStar21([0.17056930775176_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(9:14))
FEM_Zoo_QuadratureWeights(2,5)%p(8:10) = 0.03245849762320_pReal
call FEM_Zoo_permutationStar21([0.05054722831703_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(15:20))
FEM_Zoo_QuadratureWeights(2,5)%p(11:16) = 0.02723031417443_pReal
call FEM_Zoo_permutationStar111([0.26311282963464_pReal, 0.72849239295540_pReal], &
FEM_Zoo_QuadraturePoints(2,5)%p(21:32))
!--------------------------------------------------------------------------------------------------
! 3D linear
FEM_Zoo_nQuadrature(3,1) = 1
allocate(FEM_Zoo_QuadratureWeights(3,1)%p(1))
allocate(FEM_Zoo_QuadraturePoints (3,1)%p(3))
FEM_Zoo_QuadratureWeights(3,1)%p(1) = 1.0_pReal
call FEM_Zoo_permutationStar4([0.25_pReal], &
FEM_Zoo_QuadraturePoints(3,1)%p(1:3))
!--------------------------------------------------------------------------------------------------
! 3D quadratic
FEM_Zoo_nQuadrature(3,2) = 4
allocate(FEM_Zoo_QuadratureWeights(3,2)%p(4 ))
allocate(FEM_Zoo_QuadraturePoints (3,2)%p(12))
FEM_Zoo_QuadratureWeights(3,2)%p(1:4) = 0.25_pReal
call FEM_Zoo_permutationStar31([0.13819660112501051518_pReal], &
FEM_Zoo_QuadraturePoints(3,2)%p(1:12))
!--------------------------------------------------------------------------------------------------
! 3D cubic
FEM_Zoo_nQuadrature(3,3) = 14
allocate(FEM_Zoo_QuadratureWeights(3,3)%p(14))
allocate(FEM_Zoo_QuadraturePoints (3,3)%p(42))
FEM_Zoo_QuadratureWeights(3,3)%p(1:4) = 0.073493043116361949544_pReal
call FEM_Zoo_permutationStar31([0.092735250310891226402_pReal], &
FEM_Zoo_QuadraturePoints(3,3)%p(1:12))
FEM_Zoo_QuadratureWeights(3,3)%p(5:8) = 0.11268792571801585080_pReal
call FEM_Zoo_permutationStar31([0.31088591926330060980_pReal], &
FEM_Zoo_QuadraturePoints(3,3)%p(13:24))
FEM_Zoo_QuadratureWeights(3,3)%p(9:14) = 0.042546020777081466438_pReal
call FEM_Zoo_permutationStar22([0.045503704125649649492_pReal], &
FEM_Zoo_QuadraturePoints(3,3)%p(25:42))
!--------------------------------------------------------------------------------------------------
! 3D quartic
FEM_Zoo_nQuadrature(3,4) = 35
allocate(FEM_Zoo_QuadratureWeights(3,4)%p(35))
allocate(FEM_Zoo_QuadraturePoints (3,4)%p(105))
FEM_Zoo_QuadratureWeights(3,4)%p(1:4) = 0.0021900463965388_pReal
call FEM_Zoo_permutationStar31([0.0267367755543735_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(1:12))
FEM_Zoo_QuadratureWeights(3,4)%p(5:16) = 0.0143395670177665_pReal
call FEM_Zoo_permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(13:48))
FEM_Zoo_QuadratureWeights(3,4)%p(17:22) = 0.0250305395686746_pReal
call FEM_Zoo_permutationStar22([0.4547545999844830_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(49:66))
FEM_Zoo_QuadratureWeights(3,4)%p(23:34) = 0.0479839333057554_pReal
call FEM_Zoo_permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(67:102))
FEM_Zoo_QuadratureWeights(3,4)%p(35) = 0.0931745731195340_pReal
call FEM_Zoo_permutationStar4([0.25_pReal], &
FEM_Zoo_QuadraturePoints(3,4)%p(103:105))
!--------------------------------------------------------------------------------------------------
! 3D quintic
FEM_Zoo_nQuadrature(3,5) = 56
allocate(FEM_Zoo_QuadratureWeights(3,5)%p(56))
allocate(FEM_Zoo_QuadraturePoints (3,5)%p(168))
FEM_Zoo_QuadratureWeights(3,5)%p(1:4) = 0.0010373112336140_pReal
call FEM_Zoo_permutationStar31([0.0149520651530592_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(1:12))
FEM_Zoo_QuadratureWeights(3,5)%p(5:16) = 0.0096016645399480_pReal
call FEM_Zoo_permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(13:48))
FEM_Zoo_QuadratureWeights(3,5)%p(17:28) = 0.0164493976798232_pReal
call FEM_Zoo_permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(49:84))
FEM_Zoo_QuadratureWeights(3,5)%p(29:40) = 0.0153747766513310_pReal
call FEM_Zoo_permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(85:120))
FEM_Zoo_QuadratureWeights(3,5)%p(41:52) = 0.0293520118375230_pReal
call FEM_Zoo_permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(121:156))
FEM_Zoo_QuadratureWeights(3,5)%p(53:56) = 0.0366291366405108_pReal
call FEM_Zoo_permutationStar31([0.1344783347929940_pReal], &
FEM_Zoo_QuadraturePoints(3,5)%p(157:168))
end subroutine FEM_Zoo_init
!--------------------------------------------------------------------------------------------------
!> @brief star 3 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar3(point,qPt)
implicit none
real(pReal) :: point(1), qPt(2,1), temp(3,1)
temp(:,1) = [point(1), point(1), point(1)]
qPt = matmul(triangle, temp)
end subroutine FEM_Zoo_permutationStar3
!--------------------------------------------------------------------------------------------------
!> @brief star 21 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar21(point,qPt)
implicit none
real(pReal) :: point(1), qPt(2,3), temp(3,3)
temp(:,1) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1)]
temp(:,2) = [point(1), 1.0_pReal - 2.0_pReal*point(1), point(1)]
temp(:,3) = [1.0_pReal - 2.0_pReal*point(1), point(1), point(1)]
qPt = matmul(triangle, temp)
end subroutine FEM_Zoo_permutationStar21
!--------------------------------------------------------------------------------------------------
!> @brief star 111 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar111(point,qPt)
implicit none
real(pReal) :: point(2), qPt(2,6), temp(3,6)
temp(:,1) = [point(1), point(2), 1.0_pReal - point(1) - point(2)]
temp(:,2) = [point(1), 1.0_pReal - point(1) - point(2), point(2)]
temp(:,4) = [point(2), 1.0_pReal - point(1) - point(2), point(1)]
temp(:,5) = [1.0_pReal - point(1) - point(2), point(2), point(1)]
temp(:,6) = [1.0_pReal - point(1) - point(2), point(1), point(2)]
qPt = matmul(triangle, temp)
end subroutine FEM_Zoo_permutationStar111
!--------------------------------------------------------------------------------------------------
!> @brief star 4 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar4(point,qPt)
implicit none
real(pReal) :: point(1), qPt(3,1), temp(4,1)
temp(:,1) = [point(1), point(1), point(1), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar4
!--------------------------------------------------------------------------------------------------
!> @brief star 31 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar31(point,qPt)
implicit none
real(pReal) :: point(1), qPt(3,4), temp(4,4)
temp(:,1) = [point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1)]
temp(:,2) = [point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1)]
temp(:,3) = [point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1)]
temp(:,4) = [1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar31
!--------------------------------------------------------------------------------------------------
!> @brief star 22 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar22(point,qPt)
implicit none
real(pReal) :: point(1), qPt(3,6), temp(4,6)
temp(:,1) = [point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1)]
temp(:,2) = [point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1)]
temp(:,3) = [0.5_pReal - point(1), point(1), point(1), 0.5_pReal - point(1)]
temp(:,4) = [0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1)]
temp(:,5) = [0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1)]
temp(:,6) = [point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar22
!--------------------------------------------------------------------------------------------------
!> @brief star 211 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar211(point,qPt)
implicit none
real(pReal) :: point(2), qPt(3,12), temp(4,12)
temp(:,1 ) = [point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
temp(:,2 ) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2)]
temp(:,3 ) = [point(1), point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
temp(:,4 ) = [point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)]
temp(:,5 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2)]
temp(:,6 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1)]
temp(:,7 ) = [point(2), point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)]
temp(:,8 ) = [point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)]
temp(:,9 ) = [point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1)]
temp(:,10) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2)]
temp(:,11) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1)]
temp(:,12) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar211
!--------------------------------------------------------------------------------------------------
!> @brief star 1111 permutation of input
!--------------------------------------------------------------------------------------------------
subroutine FEM_Zoo_permutationStar1111(point,qPt)
implicit none
real(pReal) :: point(3), qPt(3,24), temp(4,24)
temp(:,1 ) = [point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3)]
temp(:,2 ) = [point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3)]
temp(:,3 ) = [point(1), point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3)]
temp(:,4 ) = [point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2)]
temp(:,5 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(3)]
temp(:,6 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(2)]
temp(:,7 ) = [point(2), point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3)]
temp(:,8 ) = [point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3)]
temp(:,9 ) = [point(2), point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3)]
temp(:,10) = [point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1)]
temp(:,11) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(3)]
temp(:,12) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(1)]
temp(:,13) = [point(3), point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3)]
temp(:,14) = [point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2)]
temp(:,15) = [point(3), point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3)]
temp(:,16) = [point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1)]
temp(:,17) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(2)]
temp(:,18) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(1)]
temp(:,19) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), point(3)]
temp(:,20) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), point(2)]
temp(:,21) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), point(3)]
temp(:,22) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), point(1)]
temp(:,23) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), point(2)]
temp(:,24) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), point(1)]
qPt = matmul(tetrahedron, temp)
end subroutine FEM_Zoo_permutationStar1111
end module FEM_Zoo

9
src/FEsolving.f90
View File

@ -81,20 +81,13 @@ subroutine FE_init
modelName = getSolverJobName()
#if defined(Spectral) || defined(FEM)
#ifdef Spectral
restartInc = spectralRestartInc
#endif
#ifdef FEM
restartInc = FEMRestartInc
#endif
restartInc = interface_RestartInc
if(restartInc < 0_pInt) then
call IO_warning(warning_ID=34_pInt)
restartInc = 0_pInt
endif
restartRead = restartInc > 0_pInt ! only read in if "true" restart requested
#else
call IO_open_inputFile(FILEUNIT,modelName)
rewind(FILEUNIT)

1334
src/HDF5_utilities.f90 Normal file
View File

File diff suppressed because it is too large Load Diff

356
src/IO.f90
View File

@ -22,6 +22,7 @@ module IO
public :: &
IO_init, &
IO_read, &
IO_recursiveRead, &
IO_checkAndRewind, &
IO_open_file_stat, &
IO_open_jobFile_stat, &
@ -35,10 +36,6 @@ module IO
IO_hybridIA, &
IO_isBlank, &
IO_getTag, &
IO_countSections, &
IO_countTagInPart, &
IO_spotTagInPart, &
IO_globalTagInPart, &
IO_stringPos, &
IO_stringValue, &
IO_fixedStringValue ,&
@ -100,6 +97,7 @@ end subroutine IO_init
!--------------------------------------------------------------------------------------------------
!> @brief recursively reads a line from a text file.
!! Recursion is triggered by "{path/to/inputfile}" in a line
!> @details unstable and buggy
!--------------------------------------------------------------------------------------------------
recursive function IO_read(fileUnit,reset) result(line)
@ -151,7 +149,7 @@ recursive function IO_read(fileUnit,reset) result(line)
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') ! open included file
open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read',status='old',position='rewind') ! open included file
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack))
line = IO_read(fileUnit)
@ -170,6 +168,80 @@ recursive function IO_read(fileUnit,reset) result(line)
end function IO_read
!--------------------------------------------------------------------------------------------------
!> @brief recursively reads a text file.
!! Recursion is triggered by "{path/to/inputfile}" in a line
!--------------------------------------------------------------------------------------------------
recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
implicit none
character(len=*), intent(in) :: fileName
integer(pInt), intent(in), optional :: cnt !< recursion counter
character(len=256), dimension(:), allocatable :: fileContent !< file content, separated per lines
character(len=256), dimension(:), allocatable :: includedContent
character(len=256) :: line
character(len=256), parameter :: dummy = 'https://damask.mpie.de' !< to fill up remaining array
character(len=:), allocatable :: rawData
integer(pInt) :: &
fileLength, &
fileUnit, &
startPos, endPos, &
myTotalLines, & !< # lines read from file without include statements
includedLines, & !< # lines included from other file(s)
missingLines, & !< # lines missing from current file
l,i, &
myStat
if (merge(cnt,0_pInt,present(cnt))>10_pInt) call IO_error(106_pInt,ext_msg=trim(fileName))
!--------------------------------------------------------------------------------------------------
! read data as stream
inquire(file = fileName, size=fileLength)
open(newunit=fileUnit, file=fileName, access='stream',&
status='old', position='rewind', action='read',iostat=myStat)
if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(fileName))
allocate(character(len=fileLength)::rawData)
read(fileUnit) rawData
close(fileUnit)
!--------------------------------------------------------------------------------------------------
! count lines to allocate string array
myTotalLines = 0_pInt
do l=1_pInt, len(rawData)
if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1
enddo
allocate(fileContent(myTotalLines))
!--------------------------------------------------------------------------------------------------
! split raw data at end of line and handle includes
startPos = 1_pInt
endPos = 0_pInt
includedLines=0_pInt
l=0_pInt
do while (startPos <= len(rawData))
l = l + 1_pInt
endPos = endPos + scan(rawData(startPos:),new_line(''))
if(endPos - startPos >256) call IO_error(107_pInt,ext_msg=trim(fileName))
line = rawData(startPos:endPos-1_pInt)
startPos = endPos + 1_pInt
recursion: if(scan(trim(line),'{') < scan(trim(line),'}')) then
myTotalLines = myTotalLines - 1_pInt
includedContent = IO_recursiveRead(trim(line(scan(line,'{')+1_pInt:scan(line,'}')-1_pInt)), &
merge(cnt,1_pInt,present(cnt))) ! to track recursion depth
includedLines = includedLines + size(includedContent)
missingLines = myTotalLines + includedLines - size(fileContent(1:l-1)) -size(includedContent)
fileContent = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,missingLines)] ] ! add content and grow array
l = l - 1_pInt + size(includedContent)
else recursion
fileContent(l) = line
endif recursion
enddo
end function IO_recursiveRead
!--------------------------------------------------------------------------------------------------
!> @brief checks if unit is opened for reading, if true rewinds. Otherwise stops with
@ -195,19 +267,15 @@ end subroutine IO_checkAndRewind
!> @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,relPath)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
subroutine IO_open_file(fileUnit,path)
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: relPath !< relative path from working directory
character(len=*), intent(in) :: path !< relative path from working directory
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//relPath
open(fileUnit,status='old',iostat=myStat,file=path)
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)
end subroutine IO_open_file
@ -218,19 +286,16 @@ end subroutine IO_open_file
!! directory
!> @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,relPath)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
logical function IO_open_file_stat(fileUnit,path)
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
character(len=*), intent(in) :: relPath !< relative path from working directory
character(len=*), intent(in) :: path !< relative path from working directory
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//relPath
open(fileUnit,status='old',iostat=myStat,file=path)
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) close(fileUnit)
IO_open_file_stat = (myStat == 0_pInt)
end function IO_open_file_stat
@ -244,7 +309,6 @@ end function IO_open_file_stat
!--------------------------------------------------------------------------------------------------
subroutine IO_open_jobFile(fileUnit,ext)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName
implicit none
@ -254,8 +318,8 @@ subroutine IO_open_jobFile(fileUnit,ext)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
open(fileUnit,status='old',iostat=myStat,file=path)
path = trim(getSolverJobName())//'.'//ext
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)
end subroutine IO_open_jobFile
@ -269,7 +333,6 @@ end subroutine IO_open_jobFile
!--------------------------------------------------------------------------------------------------
logical function IO_open_jobFile_stat(fileUnit,ext)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName
implicit none
@ -279,8 +342,9 @@ logical function IO_open_jobFile_stat(fileUnit,ext)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
open(fileUnit,status='old',iostat=myStat,file=path)
path = trim(getSolverJobName())//'.'//ext
open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind')
if (myStat /= 0_pInt) close(fileUnit)
IO_open_jobFile_stat = (myStat == 0_pInt)
end function IO_open_JobFile_stat
@ -292,7 +356,6 @@ end function IO_open_JobFile_stat
!--------------------------------------------------------------------------------------------------
subroutine IO_open_inputFile(fileUnit,modelName)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName,&
getSolverJobName, &
inputFileExtension
@ -306,23 +369,23 @@ subroutine IO_open_inputFile(fileUnit,modelName)
integer(pInt) :: fileType
fileType = 1_pInt ! assume .pes
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used
open(fileUnit+1,status='old',iostat=myStat,file=path)
path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used
open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind')
if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp"
fileType = 2_pInt
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)
open(fileUnit+1,status='old',iostat=myStat,file=path)
path = trim(modelName)//inputFileExtension(fileType)
open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind')
endif
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)//'_assembly'
path = trim(modelName)//inputFileExtension(fileType)//'_assembly'
open(fileUnit,iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s
close(fileUnit+1_pInt)
#endif
#ifdef Marc4DAMASK
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension
path = trim(modelName)//inputFileExtension
open(fileUnit,status='old',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
#endif
@ -336,7 +399,6 @@ end subroutine IO_open_inputFile
!--------------------------------------------------------------------------------------------------
subroutine IO_open_logFile(fileUnit)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName, &
LogFileExtension
@ -346,8 +408,8 @@ subroutine IO_open_logFile(fileUnit)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//LogFileExtension
open(fileUnit,status='old',iostat=myStat,file=path)
path = trim(getSolverJobName())//LogFileExtension
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)
end subroutine IO_open_logFile
@ -360,7 +422,6 @@ end subroutine IO_open_logFile
!--------------------------------------------------------------------------------------------------
subroutine IO_write_jobFile(fileUnit,ext)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName
implicit none
@ -370,7 +431,7 @@ subroutine IO_write_jobFile(fileUnit,ext)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
path = trim(getSolverJobName())//'.'//ext
open(fileUnit,status='replace',iostat=myStat,file=path)
if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path)
@ -383,7 +444,6 @@ end subroutine IO_write_jobFile
!--------------------------------------------------------------------------------------------------
subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName
implicit none
@ -394,7 +454,7 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
path = trim(getSolverJobName())//'.'//ext
if (present(recMultiplier)) then
open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pReal*recMultiplier,iostat=myStat,file=path)
@ -414,7 +474,6 @@ end subroutine IO_write_jobRealFile
!--------------------------------------------------------------------------------------------------
subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName, &
getSolverJobName
implicit none
@ -425,7 +484,7 @@ subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext
path = trim(getSolverJobName())//'.'//ext
if (present(recMultiplier)) then
open(fileUnit,status='replace',form='unformatted',access='direct', &
recl=pInt*recMultiplier,iostat=myStat,file=path)
@ -444,8 +503,6 @@ end subroutine IO_write_jobIntFile
!! located in current working directory
!--------------------------------------------------------------------------------------------------
subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
@ -456,7 +513,7 @@ subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext
path = trim(modelName)//'.'//ext
if (present(recMultiplier)) then
open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pReal*recMultiplier,iostat=myStat,file=path)
@ -474,8 +531,6 @@ end subroutine IO_read_realFile
!! located in current working directory
!--------------------------------------------------------------------------------------------------
subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none
integer(pInt), intent(in) :: fileUnit !< file unit
@ -486,7 +541,7 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier)
integer(pInt) :: myStat
character(len=1024) :: path
path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext
path = trim(modelName)//'.'//ext
if (present(recMultiplier)) then
open(fileUnit,status='old',form='unformatted',access='direct', &
recl=pInt*recMultiplier,iostat=myStat,file=path)
@ -774,16 +829,22 @@ pure function IO_getTag(string,openChar,closeChar)
character(len=*), intent(in) :: string !< string to check for tag
character(len=len_trim(string)) :: IO_getTag
character(len=*), intent(in) :: openChar, & !< indicates beginning of tag
character, intent(in) :: openChar, & !< indicates beginning of tag
closeChar !< indicates end of tag
character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
integer :: left,right ! no pInt
IO_getTag = ''
if (openChar /= closeChar) then
left = scan(string,openChar)
right = scan(string,closeChar)
else
left = scan(string,openChar)
right = left + merge(scan(string(left+1:),openChar),0_pInt,len(string) > left)
endif
if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs
IO_getTag = string(left+1:right-1)
@ -791,173 +852,6 @@ pure function IO_getTag(string,openChar,closeChar)
end function IO_getTag
!--------------------------------------------------------------------------------------------------
!> @brief count number of [sections] in <part> for given file handle
!--------------------------------------------------------------------------------------------------
integer(pInt) function IO_countSections(fileUnit,part)
implicit none
integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*), intent(in) :: part !< part name in which sections are counted
character(len=65536) :: line
line = ''
IO_countSections = 0_pInt
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part
line = IO_read(fileUnit)
enddo
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier
IO_countSections = IO_countSections + 1_pInt
enddo
end function IO_countSections
!--------------------------------------------------------------------------------------------------
!> @brief returns array of tag counts within <part> for at most N [sections]
!--------------------------------------------------------------------------------------------------
function IO_countTagInPart(fileUnit,part,tag,Nsections)
implicit none
integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for
integer(pInt), dimension(Nsections) :: IO_countTagInPart
integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for
integer(pInt), dimension(Nsections) :: counter
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: section
character(len=65536) :: line
line = ''
counter = 0_pInt
section = 0_pInt
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part
line = IO_read(fileUnit)
enddo
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier
if (section > 0) then
chunkPos = IO_stringPos(line)
if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match
counter(section) = counter(section) + 1_pInt
endif
enddo
IO_countTagInPart = counter
end function IO_countTagInPart
!--------------------------------------------------------------------------------------------------
!> @brief returns array of tag presence within <part> for at most N [sections]
!--------------------------------------------------------------------------------------------------
function IO_spotTagInPart(fileUnit,part,tag,Nsections)
implicit none
integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for
logical, dimension(Nsections) :: IO_spotTagInPart
integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: section
character(len=65536) :: line
IO_spotTagInPart = .false. ! assume to nowhere spot tag
section = 0_pInt
line = ''
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part
line = IO_read(fileUnit)
enddo
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier
if (section > 0_pInt) then
chunkPos = IO_stringPos(line)
if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match
IO_spotTagInPart(section) = .true.
endif
enddo
end function IO_spotTagInPart
!--------------------------------------------------------------------------------------------------
!> @brief return logical whether tag is present within <part> before any [sections]
!--------------------------------------------------------------------------------------------------
logical function IO_globalTagInPart(fileUnit,part,tag)
implicit none
integer(pInt), intent(in) :: fileUnit !< file handle
character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=65536) :: line
IO_globalTagInPart = .false. ! assume to nowhere spot tag
line =''
rewind(fileUnit)
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part
line = IO_read(fileUnit)
enddo
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundNextPart
foundFirstSection: if (IO_getTag(line,'[',']') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundFirstSection
chunkPos = IO_stringPos(line)
match: if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) then
IO_globalTagInPart = .true.
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif match
enddo
end function IO_globalTagInPart
!--------------------------------------------------------------------------------------------------
!> @brief locates all space-separated chunks in given string and returns array containing number
!! them and the left/right position to be used by IO_xxxVal
@ -1007,11 +901,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent)
logical :: warn
if (.not. present(silent)) then
warn = .false.
else
warn = silent
endif
warn = merge(silent,.false.,present(silent))
IO_stringValue = ''
valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then
@ -1473,12 +1363,16 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN)
pure function IO_intOut(intToPrint)
implicit none
character(len=19) :: N_Digits ! maximum digits for 64 bit integer
character(len=40) :: IO_intOut
integer(pInt), intent(in) :: intToPrint
character(len=41) :: IO_intOut
integer(pInt) :: N_digits
character(len=19) :: width ! maximum digits for 64 bit integer
character(len=20) :: min_width ! longer for negative values
write(N_Digits, '(I19.19)') 1_pInt + int(log10(real(intToPrint)),pInt)
IO_intOut = 'I'//trim(N_Digits)//'.'//trim(N_Digits)
N_digits = 1_pInt + int(log10(real(max(abs(intToPrint),1_pInt))),pInt)
write(width, '(I19.19)') N_digits
write(min_width, '(I20.20)') N_digits + merge(1_pInt,0_pInt,intToPrint < 0_pInt)
IO_intOut = 'I'//trim(min_width)//'.'//trim(width)
end function IO_intOut
@ -1534,6 +1428,10 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
msg = '{input} recursion limit reached'
case (105_pInt)
msg = 'unknown output:'
case (106_pInt)
msg = 'working directory does not exist:'
case (107_pInt)
msg = 'line length exceeds limit of 256'
!--------------------------------------------------------------------------------------------------
! lattice error messages
@ -1579,6 +1477,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
msg = 'illegal texture transformation specified'
case (160_pInt)
msg = 'no entries in config part'
case (161_pInt)
msg = 'config part found twice'
case (165_pInt)
msg = 'homogenization configuration'
case (170_pInt)
@ -1676,7 +1576,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
case (845_pInt)
msg = 'incomplete information in spectral mesh header'
case (846_pInt)
msg = 'not a rotation defined for loadcase rotation'
msg = 'rotation for load case rotation ill-defined (R:RT != I)'
case (847_pInt)
msg = 'update of gamma operator not possible when pre-calculated'
case (880_pInt)
@ -1905,8 +1805,6 @@ end function IO_verifyFloatValue
!> including "include"s
!--------------------------------------------------------------------------------------------------
recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
use DAMASK_interface, only: &
getSolverWorkingDirectoryName
implicit none
integer(pInt), intent(in) :: unit1, &
@ -1923,7 +1821,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess)
chunkPos = IO_stringPos(line)
if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then
fname = trim(getSolverWorkingDirectoryName())//trim(line(9+scan(line(9:),'='):))
fname = trim(line(9+scan(line(9:),'='):))
inquire(file=fname, exist=fexist)
if (.not.(fexist)) then
!$OMP CRITICAL (write2out)

286
src/config.f90
View File

@ -20,12 +20,17 @@ module config
type, public :: tPartitionedStringList
type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null()
contains
procedure :: add => add
procedure :: show => show
procedure :: free => free
! currently, a finalize is needed for all shapes of tPartitionedStringList.
! with Fortran 2015, we can define one recursive elemental function
! https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/543326
final :: finalize, &
finalizeArray
procedure :: keyExists => keyExists
procedure :: countKeys => countKeys
@ -37,11 +42,10 @@ module config
procedure :: getInts => getInts
procedure :: getStrings => getStrings
end type tPartitionedStringList
type(tPartitionedStringList), public :: emptyList
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX?
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: &
config_phase, &
config_microstructure, &
config_homogenization, &
@ -76,7 +80,6 @@ module config
MATERIAL_configFile = 'material.config', & !< generic name for material configuration file
MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file
public :: &
config_init, &
config_deallocate
@ -92,12 +95,14 @@ subroutine config_init()
compiler_version, &
compiler_options
#endif
use prec, only: &
pStringLen
use DAMASK_interface, only: &
getSolverJobName
use IO, only: &
IO_error, &
IO_open_file, &
IO_read, &
IO_lc, &
IO_open_jobFile_stat, &
IO_recursiveRead, &
IO_getTag, &
IO_timeStamp, &
IO_EOF
@ -107,12 +112,13 @@ subroutine config_init()
debug_levelBasic
implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt) :: myDebug
integer(pInt) :: myDebug,i
character(len=65536) :: &
character(len=pStringLen) :: &
line, &
part
character(len=pStringLen), dimension(:), allocatable :: fileContent
logical :: fileExists
write(6,'(/,a)') ' <<<+- config init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -120,39 +126,40 @@ subroutine config_init()
myDebug = debug_level(debug_material)
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file
inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=fileExists)
if(fileExists) then
fileContent = IO_recursiveRead(trim(getSolverJobName())//'.'//material_localFileExt)
else
inquire(file='material.config',exist=fileExists)
if(.not. fileExists) call IO_error(100_pInt,ext_msg='material.config')
fileContent = IO_recursiveRead('material.config')
endif
rewind(fileUnit)
line = '' ! to have it initialized
do while (trim(line) /= IO_EOF)
do i = 1_pInt, size(fileContent)
line = trim(fileContent(i))
part = IO_lc(IO_getTag(line,'<','>'))
select case (trim(part))
case (trim(material_partPhase))
call parseFile(line,phase_name,config_phase,FILEUNIT)
call parseFile(phase_name,config_phase,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
case (trim(material_partMicrostructure))
call parseFile(line,microstructure_name,config_microstructure,FILEUNIT)
call parseFile(microstructure_name,config_microstructure,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
case (trim(material_partCrystallite))
call parseFile(line,crystallite_name,config_crystallite,FILEUNIT)
call parseFile(crystallite_name,config_crystallite,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim(material_partHomogenization))
call parseFile(line,homogenization_name,config_homogenization,FILEUNIT)
call parseFile(homogenization_name,config_homogenization,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
case (trim(material_partTexture))
call parseFile(line,texture_name,config_texture,FILEUNIT)
call parseFile(texture_name,config_texture,line,fileContent(i+1:))
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
case default
line = IO_read(fileUnit)
end select
enddo
@ -173,107 +180,83 @@ end subroutine config_init
!--------------------------------------------------------------------------------------------------
!> @brief parses the material.config file
!--------------------------------------------------------------------------------------------------
subroutine parseFile(line,&
sectionNames,part,fileUnit)
subroutine parseFile(sectionNames,part,line, &
fileContent)
use prec, only: &
pStringLen
use IO, only: &
IO_read, &
IO_error, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
IO_stringPos, &
IO_EOF
IO_getTag
implicit none
integer(pInt), intent(in) :: fileUnit
character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames
character(len=64), allocatable, dimension(:), intent(out) :: sectionNames
type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part
character(len=65536),intent(out) :: line
character(len=pStringLen), intent(inout) :: line
character(len=pStringLen), dimension(:), intent(in) :: fileContent
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: s
character(len=65536) :: devNull
character(len=64) :: tag
integer(pInt), allocatable, dimension(:) :: partPosition ! position of [] tags + last line in section
integer(pInt) :: i, j
logical :: echo
echo = .false.
allocate(part(0))
s = 0_pInt
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
devNull = IO_read(fileUnit, .true.) ! reset IO_read to close any recursively included files
exit
endif foundNextPart
if (allocated(part)) call IO_error(161_pInt,ext_msg=trim(line))
allocate(partPosition(0))
do i = 1_pInt, size(fileContent)
line = trim(fileContent(i))
if (IO_getTag(line,'<','>') /= '') exit
nextSection: if (IO_getTag(line,'[',']') /= '') then
s = s + 1_pInt
part = [part, emptyList]
tag = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(sectionNames)) then
allocate(sectionNames(1),source=tag)
else GfortranBug86033
sectionNames = [sectionNames,tag]
endif GfortranBug86033
partPosition = [partPosition, i]
cycle
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (s > 0_pInt) then
call part(s)%add(IO_lc(trim(line)))
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
if (size(partPosition) < 1_pInt) &
echo = (trim(IO_getTag(line,'/','/')) == 'echo') .or. echo
enddo
if (echo) then
do s = 1, size(sectionNames)
call part(s)%show()
allocate(sectionNames(size(partPosition)))
allocate(part(size(partPosition)))
partPosition = [partPosition, i] ! needed when actually storing content
do i = 1_pInt, size(partPosition) -1_pInt
sectionNames(i) = trim(adjustl(fileContent(partPosition(i))))
do j = partPosition(i) + 1_pInt, partPosition(i+1) -1_pInt
call part(i)%add(trim(adjustl(fileContent(j))))
enddo
if (echo) then
write(6,*) 'section',i, '"'//trim(sectionNames(i))//'"'
call part(i)%show()
endif
enddo
end subroutine parseFile
!--------------------------------------------------------------------------------------------------
!> @brief deallocates the linked lists that store the content of the configuration files
!--------------------------------------------------------------------------------------------------
subroutine config_deallocate(what)
use IO, only: &
IO_error
implicit none
character(len=*), intent(in) :: what
integer(pInt) :: i
select case(what)
select case(trim(what))
case('material.config/phase')
do i=1, size(config_phase)
call config_phase(i)%free
enddo
deallocate(config_phase)
case('material.config/microstructure')
do i=1, size(config_microstructure)
call config_microstructure(i)%free
enddo
deallocate(config_microstructure)
case('material.config/crystallite')
do i=1, size(config_crystallite)
call config_crystallite(i)%free
enddo
deallocate(config_crystallite)
case('material.config/homogenization')
do i=1, size(config_homogenization)
call config_homogenization(i)%free
enddo
deallocate(config_homogenization)
case('material.config/texture')
do i=1, size(config_texture)
call config_texture(i)%free
enddo
deallocate(config_texture)
case default
@ -284,11 +267,17 @@ subroutine config_deallocate(what)
end subroutine config_deallocate
!##################################################################################################
! The folowing functions are part of the tPartitionedStringList object
!##################################################################################################
!--------------------------------------------------------------------------------------------------
!> @brief add element
!> @details Adds a string together with the start/end position of chunks in this string. The new
!! element is added at the end of the list. Empty strings are not added. All strings are converted
!! to lower case
!! to lower case. The data is not stored in the new element but in the current.
!--------------------------------------------------------------------------------------------------
subroutine add(this,string)
use IO, only: &
@ -299,19 +288,18 @@ subroutine add(this,string)
implicit none
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: string
type(tPartitionedStringList), pointer :: new, item
type(tPartitionedStringList), pointer :: new, temp
if (IO_isBlank(string)) return
allocate(new)
new%string%val = IO_lc (trim(string))
new%string%pos = IO_stringPos(trim(string))
item => this
do while (associated(item%next))
item => item%next
temp => this
do while (associated(temp%next))
temp => temp%next
enddo
item%next => new
temp%string%val = IO_lc (trim(string))
temp%string%pos = IO_stringPos(trim(string))
temp%next => new
end subroutine add
@ -323,12 +311,12 @@ end subroutine add
subroutine show(this)
implicit none
class(tPartitionedStringList) :: this
class(tPartitionedStringList), target, intent(in) :: this
type(tPartitionedStringList), pointer :: item
item => this%next
do while (associated(item))
write(6,'(a)') trim(item%string%val)
item => this
do while (associated(item%next))
write(6,'(a)') ' '//trim(item%string%val)
item => item%next
end do
@ -336,28 +324,55 @@ end subroutine show
!--------------------------------------------------------------------------------------------------
!> @brief cleans entire list
!> @details list head is remains alive
!> @brief empties list and frees associated memory
!> @details explicit interface to reset list. Triggers final statement (and following chain reaction)
!--------------------------------------------------------------------------------------------------
subroutine free(this)
implicit none
class(tPartitionedStringList), target, intent(in) :: this
type(tPartitionedStringList), pointer :: new, item
class(tPartitionedStringList), intent(inout) :: this
if (.not. associated(this%next)) return
item => this%next
do while (associated(item%next))
new => item
deallocate(item)
item => new%next
enddo
deallocate(item)
if(associated(this%next)) deallocate(this%next)
end subroutine free
!--------------------------------------------------------------------------------------------------
!> @brief empties list and frees associated memory
!> @details called when variable goes out of scope. Triggers chain reaction for list
!--------------------------------------------------------------------------------------------------
recursive subroutine finalize(this)
implicit none
type(tPartitionedStringList), intent(inout) :: this
if(associated(this%next)) deallocate(this%next)
end subroutine finalize
!--------------------------------------------------------------------------------------------------
!> @brief cleans entire array of linke lists
!> @details called when variable goes out of scope and deallocates the list at each array entry
!--------------------------------------------------------------------------------------------------
subroutine finalizeArray(this)
implicit none
integer :: i
type(tPartitionedStringList), intent(inout), dimension(:) :: this
type(tPartitionedStringList), pointer :: temp ! bug in Gfortran?
do i=1, size(this)
if (associated(this(i)%next)) then
temp => this(i)%next
!deallocate(this(i)) !internal compiler error: in gfc_build_final_call, at fortran/trans.c:975
deallocate(temp)
endif
enddo
end subroutine finalizeArray
!--------------------------------------------------------------------------------------------------
!> @brief reports wether a given key (string value at first position) exists in the list
!--------------------------------------------------------------------------------------------------
@ -366,14 +381,14 @@ logical function keyExists(this,key)
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item
keyExists = .false.
item => this%next
do while (associated(item) .and. .not. keyExists)
item => this
do while (associated(item%next) .and. .not. keyExists)
keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
item => item%next
end do
@ -391,14 +406,14 @@ integer(pInt) function countKeys(this,key)
implicit none
class(tPartitionedStringList), intent(in) :: this
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item
countKeys = 0_pInt
item => this%next
do while (associated(item))
item => this
do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) &
countKeys = countKeys + 1_pInt
item => item%next
@ -419,7 +434,7 @@ real(pReal) function getFloat(this,key,defaultVal)
IO_FloatValue
implicit none
class(tPartitionedStringList), intent(in) :: this
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
@ -428,8 +443,8 @@ real(pReal) function getFloat(this,key,defaultVal)
found = present(defaultVal)
if (found) getFloat = defaultVal
item => this%next
do while (associated(item))
item => this
do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
@ -455,7 +470,7 @@ integer(pInt) function getInt(this,key,defaultVal)
IO_IntValue
implicit none
class(tPartitionedStringList), intent(in) :: this
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
@ -464,8 +479,8 @@ integer(pInt) function getInt(this,key,defaultVal)
found = present(defaultVal)
if (found) getInt = defaultVal
item => this%next
do while (associated(item))
item => this
do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
@ -491,7 +506,7 @@ character(len=65536) function getString(this,key,defaultVal,raw)
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536), intent(in), optional :: defaultVal
logical, intent(in), optional :: raw
@ -506,8 +521,8 @@ character(len=65536) function getString(this,key,defaultVal,raw)
if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString')
endif
item => this%next
do while (associated(item))
item => this
do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
@ -539,7 +554,7 @@ function getFloats(this,key,defaultVal,requiredShape)
implicit none
real(pReal), dimension(:), allocatable :: getFloats
class(tPartitionedStringList), intent(in) :: this
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape
@ -553,8 +568,8 @@ function getFloats(this,key,defaultVal,requiredShape)
allocate(getFloats(0))
item => this%next
do while (associated(item))
item => this
do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (.not. cumulative) getFloats = [real(pReal)::]
@ -586,7 +601,7 @@ function getInts(this,key,defaultVal,requiredShape)
implicit none
integer(pInt), dimension(:), allocatable :: getInts
class(tPartitionedStringList), intent(in) :: this
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), dimension(:), intent(in), optional :: defaultVal, &
requiredShape
@ -600,8 +615,8 @@ function getInts(this,key,defaultVal,requiredShape)
allocate(getInts(0))
item => this%next
do while (associated(item))
item => this
do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (.not. cumulative) getInts = [integer(pInt)::]
@ -633,7 +648,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw)
implicit none
character(len=65536),dimension(:), allocatable :: getStrings
class(tPartitionedStringList), intent(in) :: this
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536),dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape
@ -649,8 +664,8 @@ function getStrings(this,key,defaultVal,requiredShape,raw)
whole = merge(raw,.false.,present(raw))
found = .false.
item => this%next
do while (associated(item))
item => this
do while (associated(item%next))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings)
@ -670,6 +685,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw)
endif
else notAllocated
if (whole) then
str = item%string%val(item%string%pos(4):)
getStrings = [getStrings,str]
else
do i=2_pInt,item%string%pos(1)

24
src/constitutive.f90
View File

@ -58,14 +58,15 @@ subroutine constitutive_init()
IO_write_jobIntFile, &
IO_timeStamp
use config, only: &
config_deallocate
config_phase
use mesh, only: &
FE_geomtype
use config, only: &
material_Nphase, &
material_localFileExt, &
phase_name, &
material_configFile
material_configFile, &
config_deallocate
use material, only: &
material_phase, &
phase_plasticity, &
@ -138,7 +139,7 @@ subroutine constitutive_init()
use kinematics_hydrogen_strain
implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt), parameter :: FILEUNIT = 204_pInt
integer(pInt) :: &
o, & !< counter in output loop
ph, & !< counter in phase loop
@ -160,7 +161,7 @@ subroutine constitutive_init()
! parse plasticities from config file
if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init
if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init
if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT)
if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init
if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT)
if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT)
if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT)
@ -864,19 +865,11 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra
FpArray !< plastic deformation gradient
real(pReal), intent(in), dimension(6) :: &
Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel)
integer(pLongInt) :: &
tick = 0_pLongInt, &
tock = 0_pLongInt, &
tickrate, &
maxticks
integer(pInt) :: &
ho, & !< homogenization
tme, & !< thermal member position
s !< counter in source loop
if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) &
call system_clock(count=tick,count_rate=tickrate,count_max=maxticks)
ho = material_homog( ip,el)
tme = thermalMapping(ho)%p(ip,el)
@ -957,13 +950,6 @@ subroutine constitutive_collectDeltaState(Tstar_v, Fe, ipc, ip, el)
Fe !< elastic deformation gradient
integer(pInt) :: &
s !< counter in source loop
integer(pLongInt) :: &
tick, tock, &
tickrate, &
maxticks
if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) &
call system_clock(count=tick,count_rate=tickrate,count_max=maxticks)
plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
case (PLASTICITY_KINEHARDENING_ID) plasticityType

90
src/crystallite.f90
View File

@ -114,6 +114,7 @@ module crystallite
end enum
integer(kind(undefined_ID)),dimension(:,:), allocatable, private :: &
crystallite_outputID !< ID of each post result output
procedure(), pointer :: integrateState
public :: &
crystallite_init, &
@ -122,6 +123,7 @@ module crystallite
crystallite_push33ToRef, &
crystallite_postResults
private :: &
integrateState, &
crystallite_integrateStateFPI, &
crystallite_integrateStateEuler, &
crystallite_integrateStateAdaptiveEuler, &
@ -149,6 +151,7 @@ subroutine crystallite_init
debug_crystallite, &
debug_levelBasic
use numerics, only: &
numerics_integrator, &
worldrank, &
usePingPong
use math, only: &
@ -172,9 +175,10 @@ subroutine crystallite_init
IO_error
use material
use config, only: &
config_deallocate, &
config_crystallite, &
crystallite_name, &
config_deallocate
material_Nphase
use constitutive, only: &
constitutive_initialFi, &
constitutive_microstructure ! derived (shortcut) quantities of given state
@ -187,7 +191,8 @@ subroutine crystallite_init
i, & !< counter in integration point loop
e, & !< counter in element loop
o = 0_pInt, & !< counter in output loop
r, & !< counter in crystallite loop
r, &
ph, & !< counter in crystallite loop
cMax, & !< maximum number of integration point components
iMax, & !< maximum number of integration points
eMax, & !< maximum number of elements
@ -269,6 +274,20 @@ subroutine crystallite_init
allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), &
size(config_crystallite)), source=0_pInt)
select case(numerics_integrator(1))
case(1_pInt)
integrateState => crystallite_integrateStateFPI
case(2_pInt)
integrateState => crystallite_integrateStateEuler
case(3_pInt)
integrateState => crystallite_integrateStateAdaptiveEuler
case(4_pInt)
integrateState => crystallite_integrateStateRK4
case(5_pInt)
integrateState => crystallite_integrateStateRKCK45
end select
do c = 1_pInt, size(config_crystallite)
#if defined(__GFORTRAN__)
@ -421,6 +440,19 @@ subroutine crystallite_init
enddo
!$OMP END PARALLEL DO
do ph = 1_pInt,material_Nphase
!--------------------------------------------------------------------------------------------------
! propagate dependent states to materialpoint and boundary value problem level
plasticState(ph)%partionedState0(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: &
plasticState(ph)%sizeState,:) &
= plasticState(ph)%state(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: &
plasticState(ph)%sizeState,:)
plasticState(ph)%state0 (plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: &
plasticState(ph)%sizeState,:) &
= plasticState(ph)%state(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: &
plasticState(ph)%sizeState,:)
enddo
call crystallite_stressAndItsTangent(.true.) ! request elastic answers
crystallite_fallbackdPdF = crystallite_dPdF ! use initial elastic stiffness as fallback
@ -494,9 +526,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
subStepMinCryst, &
subStepSizeCryst, &
stepIncreaseCryst, &
nCryst, &
numerics_integrator, &
numerics_integrationMode, &
numerics_timeSyncing
use debug, only: &
debug_level, &
@ -615,6 +644,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
if (crystallite_requested(c,i,e)) then
plasticState (phaseAt(c,i,e))%subState0( :,phasememberAt(c,i,e)) = &
plasticState (phaseAt(c,i,e))%partionedState0(:,phasememberAt(c,i,e))
do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e))
sourceState(phaseAt(c,i,e))%p(mySource)%subState0( :,phasememberAt(c,i,e)) = &
sourceState(phaseAt(c,i,e))%p(mySource)%partionedState0(:,phasememberAt(c,i,e))
@ -648,7 +678,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
endif singleRun
NiterationCrystallite = 0_pInt
numerics_integrationMode = 1_pInt
cutbackLooping: do while (any(crystallite_todo(:,startIP:endIP,FEsolving_execELem(1):FEsolving_execElem(2))))
if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) &
@ -1026,25 +1055,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
! --- integrate --- requires fully defined state array (basic + dependent state)
if (any(crystallite_todo)) then
if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then
write(6,'(/,a,i3)') '<< CRYST >> using state integrator ',numerics_integrator(numerics_integrationMode)
flush(6)
endif
select case(numerics_integrator(numerics_integrationMode))
case(1_pInt)
call crystallite_integrateStateFPI()
case(2_pInt)
call crystallite_integrateStateEuler()
case(3_pInt)
call crystallite_integrateStateAdaptiveEuler()
case(4_pInt)
call crystallite_integrateStateRK4()
case(5_pInt)
call crystallite_integrateStateRKCK45()
end select
endif
if (any(crystallite_todo)) call integrateState()
where(.not. crystallite_converged .and. crystallite_subStep > subStepMinCryst) & ! do not try non-converged & fully cutbacked any further
crystallite_todo = .true.
@ -1215,8 +1226,6 @@ end subroutine crystallite_stressAndItsTangent
subroutine crystallite_integrateStateRK4()
use, intrinsic :: &
IEEE_arithmetic
use numerics, only: &
numerics_integrationMode
use debug, only: &
#ifdef DEBUG
debug_e, &
@ -1517,8 +1526,7 @@ subroutine crystallite_integrateStateRKCK45()
debug_levelExtensive, &
debug_levelSelective
use numerics, only: &
rTol_crystalliteState, &
numerics_integrationMode
rTol_crystalliteState
use FEsolving, only: &
FEsolving_execElem, &
FEsolving_execIP
@ -2013,8 +2021,7 @@ subroutine crystallite_integrateStateAdaptiveEuler()
debug_levelExtensive, &
debug_levelSelective
use numerics, only: &
rTol_crystalliteState, &
numerics_integrationMode
rTol_crystalliteState
use FEsolving, only: &
FEsolving_execElem, &
FEsolving_execIP
@ -2082,7 +2089,6 @@ subroutine crystallite_integrateStateAdaptiveEuler()
sourceStateResiduum = 0.0_pReal
relSourceStateResiduum = 0.0_pReal
integrationMode: if (numerics_integrationMode == 1_pInt) then
!$OMP PARALLEL
! --- DOT STATE (EULER INTEGRATION) ---
@ -2182,7 +2188,6 @@ subroutine crystallite_integrateStateAdaptiveEuler()
enddo; enddo; enddo
!$OMP ENDDO
!$OMP END PARALLEL
endif integrationMode
! --- STRESS INTEGRATION (EULER INTEGRATION) ---
@ -2202,9 +2207,6 @@ subroutine crystallite_integrateStateAdaptiveEuler()
enddo; enddo; enddo
!$OMP END PARALLEL DO
if (numerics_integrationMode == 1_pInt) then
!$OMP PARALLEL
! --- DOT STATE (HEUN METHOD) ---
@ -2323,17 +2325,6 @@ subroutine crystallite_integrateStateAdaptiveEuler()
!$OMP ENDDO
!$OMP END PARALLEL
elseif (numerics_integrationMode > 1) then ! stiffness calculation
!$OMP PARALLEL DO
do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains
crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! ... converged per definitionem
enddo; enddo; enddo
!$OMP END PARALLEL DO
endif
! --- NONLOCAL CONVERGENCE CHECK ---
@ -2364,7 +2355,6 @@ subroutine crystallite_integrateStateEuler()
debug_levelExtensive, &
debug_levelSelective
use numerics, only: &
numerics_integrationMode, &
numerics_timeSyncing
use FEsolving, only: &
FEsolving_execElem, &
@ -2411,7 +2401,6 @@ eIter = FEsolving_execElem(1:2)
singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2)))
if (numerics_integrationMode == 1_pInt) then
!$OMP PARALLEL
! --- DOT STATE ---
@ -2516,7 +2505,6 @@ eIter = FEsolving_execElem(1:2)
enddo; enddo; enddo
!$OMP ENDDO
!$OMP END PARALLEL
endif
!$OMP PARALLEL
@ -2581,7 +2569,6 @@ subroutine crystallite_integrateStateFPI()
debug_levelSelective
use numerics, only: &
nState, &
numerics_integrationMode, &
rTol_crystalliteState
use FEsolving, only: &
FEsolving_execElem, &
@ -3156,7 +3143,6 @@ logical function crystallite_integrateStress(&
aTol_crystalliteStress, &
rTol_crystalliteStress, &
iJacoLpresiduum, &
numerics_integrationMode, &
subStepSizeLp, &
subStepSizeLi
use debug, only: debug_level, &

8
src/debug.f90
View File

@ -102,13 +102,16 @@ subroutine debug_init
IO_EOF
implicit none
integer(pInt), parameter :: FILEUNIT = 300_pInt
integer(pInt), parameter :: FILEUNIT = 330_pInt
integer(pInt) :: i, what
integer(pInt), allocatable, dimension(:) :: chunkPos
character(len=65536) :: tag, line
write(6,'(/,a)') ' <<<+- debug init -+>>>'
#ifdef DEBUG
write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m'
#endif
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
@ -283,11 +286,8 @@ end subroutine debug_reset
subroutine debug_info
implicit none
character(len=1) :: exceed
!$OMP CRITICAL (write2out)
debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 &
.and. any(debug_stressMinLocation /= 0_pInt) &
.and. any(debug_stressMaxLocation /= 0_pInt) ) then

115
src/homogenization.f90
View File

@ -6,9 +6,6 @@
!--------------------------------------------------------------------------------------------------
module homogenization
use prec, only: &
#ifdef FEM
tOutputData, &
#endif
pInt, &
pReal
@ -22,16 +19,8 @@ module homogenization
materialpoint_P !< first P--K stress of IP
real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: &
materialpoint_dPdF !< tangent of first P--K stress at IP
#ifdef FEM
type(tOutputData), dimension(:), allocatable, public :: &
homogOutput
type(tOutputData), dimension(:,:), allocatable, public :: &
crystalliteOutput, &
phaseOutput
#else
real(pReal), dimension(:,:,:), allocatable, public :: &
materialpoint_results !< results array of material point
#endif
integer(pInt), public, protected :: &
materialpoint_sizeResults, &
homogenization_maxSizePostResults, &
@ -90,20 +79,15 @@ subroutine homogenization_init
mesh_element, &
FE_Nips, &
FE_geomtype
#ifdef FEM
use crystallite, only: &
crystallite_sizePostResults
#else
use constitutive, only: &
constitutive_plasticity_maxSizePostResults, &
constitutive_source_maxSizePostResults
use crystallite, only: &
crystallite_maxSizePostResults
#endif
use config, only: &
config_deallocate, &
material_configFile, &
material_localFileExt, &
config_deallocate, &
config_homogenization, &
homogenization_name
use material
@ -411,33 +395,6 @@ subroutine homogenization_init
hydrogenflux_maxSizePostResults = max(hydrogenflux_maxSizePostResults ,hydrogenfluxState(p)%sizePostResults)
enddo
#ifdef FEM
allocate(homogOutput (material_Nhomogenization ))
allocate(crystalliteOutput(material_Ncrystallite, homogenization_maxNgrains))
allocate(phaseOutput (material_Nphase, homogenization_maxNgrains))
do p = 1, material_Nhomogenization
homogOutput(p)%sizeResults = homogState (p)%sizePostResults + &
thermalState (p)%sizePostResults + &
damageState (p)%sizePostResults + &
vacancyfluxState (p)%sizePostResults + &
porosityState (p)%sizePostResults + &
hydrogenfluxState(p)%sizePostResults
homogOutput(p)%sizeIpCells = count(material_homog==p)
allocate(homogOutput(p)%output(homogOutput(p)%sizeResults,homogOutput(p)%sizeIpCells))
enddo
do p = 1, material_Ncrystallite; do e = 1, homogenization_maxNgrains
crystalliteOutput(p,e)%sizeResults = crystallite_sizePostResults(p)
crystalliteOutput(p,e)%sizeIpCells = count(microstructure_crystallite(mesh_element(4,:)) == p .and. &
homogenization_Ngrains (mesh_element(3,:)) >= e)*mesh_maxNips
allocate(crystalliteOutput(p,e)%output(crystalliteOutput(p,e)%sizeResults,crystalliteOutput(p,e)%sizeIpCells))
enddo; enddo
do p = 1, material_Nphase; do e = 1, homogenization_maxNgrains
phaseOutput(p,e)%sizeResults = plasticState (p)%sizePostResults + &
sum(sourceState (p)%p(:)%sizePostResults)
phaseOutput(p,e)%sizeIpCells = count(material_phase(e,:,:) == p)
allocate(phaseOutput(p,e)%output(phaseOutput(p,e)%sizeResults,phaseOutput(p,e)%sizeIpCells))
enddo; enddo
#else
materialpoint_sizeResults = 1 & ! grain count
+ 1 + homogenization_maxSizePostResults & ! homogSize & homogResult
+ thermal_maxSizePostResults &
@ -449,7 +406,6 @@ subroutine homogenization_init
+ 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results
+ constitutive_source_maxSizePostResults)
allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems))
#endif
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -473,9 +429,6 @@ subroutine homogenization_init
write(6,'(a32,1x,7(i8,1x))') 'materialpoint_requested: ', shape(materialpoint_requested)
write(6,'(a32,1x,7(i8,1x))') 'materialpoint_converged: ', shape(materialpoint_converged)
write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_doneAndHappy: ', shape(materialpoint_doneAndHappy)
#ifndef FEM
write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_results: ', shape(materialpoint_results)
#endif
write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', homogenization_maxSizePostResults
endif
flush(6)
@ -494,7 +447,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
subStepMinHomog, &
subStepSizeHomog, &
stepIncreaseHomog, &
nHomog, &
nMPstate
use math, only: &
math_transpose33
@ -905,33 +857,18 @@ subroutine materialpoint_postResults
mesh_element
use material, only: &
mappingHomogenization, &
#ifdef FEM
phaseAt, phasememberAt, &
homogenization_maxNgrains, &
material_Ncrystallite, &
material_Nphase, &
#else
homogState, &
thermalState, &
damageState, &
vacancyfluxState, &
porosityState, &
hydrogenfluxState, &
#endif
plasticState, &
sourceState, &
material_phase, &
homogenization_Ngrains, &
microstructure_crystallite
#ifdef FEM
use constitutive, only: &
constitutive_plasticity_maxSizePostResults, &
constitutive_source_maxSizePostResults
#endif
use crystallite, only: &
#ifdef FEM
crystallite_maxSizePostResults, &
#endif
crystallite_sizePostResults, &
crystallite_postResults
@ -944,55 +881,6 @@ subroutine materialpoint_postResults
g, & !< grain number
i, & !< integration point number
e !< element number
#ifdef FEM
integer(pInt) :: &
myHomog, &
myPhase, &
crystalliteCtr(material_Ncrystallite, homogenization_maxNgrains), &
phaseCtr (material_Nphase, homogenization_maxNgrains)
real(pReal), dimension(1+crystallite_maxSizePostResults + &
1+constitutive_plasticity_maxSizePostResults + &
constitutive_source_maxSizePostResults) :: &
crystalliteResults
crystalliteCtr = 0_pInt; phaseCtr = 0_pInt
elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2)
myNgrains = homogenization_Ngrains(mesh_element(3,e))
myCrystallite = microstructure_crystallite(mesh_element(4,e))
IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
myHomog = mappingHomogenization(2,i,e)
thePos = mappingHomogenization(1,i,e)
homogOutput(myHomog)%output(1: &
homogOutput(myHomog)%sizeResults, &
thePos) = homogenization_postResults(i,e)
grainLooping :do g = 1,myNgrains
myPhase = phaseAt(g,i,e)
crystalliteResults(1:1+crystallite_sizePostResults(myCrystallite) + &
1+plasticState(myPhase)%sizePostResults + &
sum(sourceState(myPhase)%p(:)%sizePostResults)) = crystallite_postResults(g,i,e)
if (microstructure_crystallite(mesh_element(4,e)) == myCrystallite .and. &
homogenization_Ngrains (mesh_element(3,e)) >= g) then
crystalliteCtr(myCrystallite,g) = crystalliteCtr(myCrystallite,g) + 1_pInt
crystalliteOutput(myCrystallite,g)% &
output(1:crystalliteOutput(myCrystallite,g)%sizeResults,crystalliteCtr(myCrystallite,g)) = &
crystalliteResults(2:1+crystalliteOutput(myCrystallite,g)%sizeResults)
endif
if (material_phase(g,i,e) == myPhase) then
phaseCtr(myPhase,g) = phaseCtr(myPhase,g) + 1_pInt
phaseOutput(myPhase,g)% &
output(1:phaseOutput(myPhase,g)%sizeResults,phaseCtr(myPhase,g)) = &
crystalliteResults(3 + crystalliteOutput(myCrystallite,g)%sizeResults: &
1 + crystalliteOutput(myCrystallite,g)%sizeResults + &
1 + plasticState (myphase)%sizePostResults + &
sum(sourceState(myphase)%p(:)%sizePostResults))
endif
enddo grainLooping
enddo IpLooping
enddo elementLooping
#else
!$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize)
elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2)
@ -1028,7 +916,6 @@ subroutine materialpoint_postResults
enddo IpLooping
enddo elementLooping
!$OMP END PARALLEL DO
#endif
end subroutine materialpoint_postResults

525
src/lattice.f90
View File

@ -16,7 +16,7 @@ module lattice
integer(pInt), parameter, public :: &
LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures
LATTICE_maxNtwinFamily = 4_pInt, & !< max # of twin system families over lattice structures
LATTICE_maxNtransFamily = 2_pInt, & !< max # of transformation system families over lattice structures
LATTICE_maxNtransFamily = 1_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 :: &
@ -82,17 +82,17 @@ module lattice
LATTICE_fcc_NtwinSystem = int([12, 0, 0, 0],pInt) !< # of twin systems per family for fcc
integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: &
LATTICE_fcc_NtransSystem = int([12, 0],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, public :: &
LATTICE_fcc_NcleavageSystem = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc
integer(pInt), parameter, private :: &
LATTICE_fcc_Nslip = 12_pInt, & !sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc
LATTICE_fcc_Ntwin = 12_pInt, & !sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc
LATTICE_fcc_Nslip = sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc
LATTICE_fcc_Ntwin = sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc
LATTICE_fcc_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for fcc
LATTICE_fcc_Ntrans = 12_pInt, & !sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc
LATTICE_fcc_Ncleavage = 7_pInt !sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc
LATTICE_fcc_Ntrans = sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc
LATTICE_fcc_Ncleavage = sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc
real(pReal), dimension(3+3,LATTICE_fcc_Nslip), parameter, private :: &
LATTICE_fcc_systemSlip = reshape(real([&
@ -111,6 +111,9 @@ module lattice
-1,-1, 0, -1, 1,-1 & ! D6
],pReal),[ 3_pInt + 3_pInt,LATTICE_fcc_Nslip]) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli
character(len=*), dimension(1), parameter, public :: LATTICE_FCC_SLIPFAMILY_NAME = &
['<0 1 -1>{1 1 1}']
real(pReal), dimension(3+3,LATTICE_fcc_Ntwin), parameter, private :: &
LATTICE_fcc_systemTwin = reshape(real( [&
-2, 1, 1, 1, 1, 1, &
@ -127,6 +130,9 @@ module lattice
-1, 1, 2, -1, 1,-1 &
],pReal),[ 3_pInt + 3_pInt,LATTICE_fcc_Ntwin]) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli
character(len=*), dimension(1), parameter, public :: LATTICE_FCC_TWINFAMILY_NAME = &
['<-2 1 1>{1 1 1}']
real(pReal), dimension(3+3,LATTICE_fcc_Ntrans), parameter, private :: &
LATTICE_fccTohex_systemTrans = reshape(real( [&
-2, 1, 1, 1, 1, 1, &
@ -365,17 +371,17 @@ module lattice
LATTICE_bcc_NtwinSystem = int([ 12, 0, 0, 0], pInt) !< # of twin systems per family for bcc
integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: &
LATTICE_bcc_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for bcc
LATTICE_bcc_NtransSystem = int([0],pInt) !< # of transformation systems per family for bcc
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: &
LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc
integer(pInt), parameter, private :: &
LATTICE_bcc_Nslip = 24_pInt, & !sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc
LATTICE_bcc_Ntwin = 12_pInt, & !sum(lattice_bcc_NtwinSystem), & !< total # of twin 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_NnonSchmid = 6_pInt, & !< total # of non-Schmid contributions for bcc (A. Koester, A. Ma, A. Hartmaier 2012)
LATTICE_bcc_Ntrans = 0_pInt, & !sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc
LATTICE_bcc_Ncleavage = 9_pInt !sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc
LATTICE_bcc_Ntrans = sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc
LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc
real(pReal), dimension(3+3,LATTICE_bcc_Nslip), parameter, private :: &
LATTICE_bcc_systemSlip = reshape(real([&
@ -433,6 +439,10 @@ module lattice
! 1,-1, 1, 3, 2,-1 &
],pReal),[ 3_pInt + 3_pInt ,LATTICE_bcc_Nslip])
character(len=*), dimension(2), parameter, public :: LATTICE_BCC_SLIPFAMILY_NAME = &
['<1 -1 1>{0 1 1}', &
'<1 -1 1>{2 1 1}']
real(pReal), dimension(3+3,LATTICE_bcc_Ntwin), parameter, private :: &
LATTICE_bcc_systemTwin = reshape(real([&
! Twin system <111>{112}
@ -450,6 +460,9 @@ module lattice
1, 1, 1, 1, 1,-2 &
],pReal),[ 3_pInt + 3_pInt,LATTICE_bcc_Ntwin])
character(len=*), dimension(1), parameter, public :: LATTICE_BCC_TWINFAMILY_NAME = &
['<1 1 1>{2 1 1}']
real(pReal), dimension(LATTICE_bcc_Ntwin), parameter, private :: &
LATTICE_bcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal)
@ -562,17 +575,17 @@ module lattice
lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex
integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: &
LATTICE_hex_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for hex
LATTICE_hex_NtransSystem = int([0],pInt) !< # of transformation systems per family for hex
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: &
LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex
integer(pInt), parameter, private :: &
LATTICE_hex_Nslip = 33_pInt, & !sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex
LATTICE_hex_Ntwin = 24_pInt, & !sum(lattice_hex_NtwinSystem), & !< total # of twin 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_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for hex
LATTICE_hex_Ntrans = 0_pInt, & !sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex
LATTICE_hex_Ncleavage = 3_pInt !sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex
LATTICE_hex_Ntrans = sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex
LATTICE_hex_Ncleavage = sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex
real(pReal), dimension(4+4,LATTICE_hex_Nslip), parameter, private :: &
LATTICE_hex_systemSlip = reshape(real([&
@ -618,6 +631,14 @@ module lattice
1, 1, -2, 3, -1, -1, 2, 2 &
],pReal),[ 4_pInt + 4_pInt,LATTICE_hex_Nslip]) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr
character(len=*), dimension(6), parameter, public :: LATTICE_HEX_SLIPFAMILY_NAME = &
['<1 1 . 1>{0 0 . 1} ', &
'<1 1 . 1>{1 0 . 0} ', &
'<1 0 . 0>{1 1 . 0} ', &
'<1 1 . 0>{-1 1 . 1} ', &
'<1 1 . 3>{-1 0 . 1} ', &
'<1 1 . 3>{-1 -1 . 2}']
real(pReal), dimension(4+4,LATTICE_hex_Ntwin), parameter, private :: &
LATTICE_hex_systemTwin = reshape(real([&
! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981)
@ -650,6 +671,12 @@ module lattice
1, 1, -2, -3, 1, 1, -2, 2 &
],pReal),[ 4_pInt + 4_pInt ,LATTICE_hex_Ntwin]) !< twin systems for hex, order follows Prof. Tom Bieler's scheme; but numbering in data was restarted from 1
character(len=*), dimension(4), parameter, public :: LATTICE_HEX_TWINFAMILY_NAME = &
['<-1 0 . 1>{1 0 . 2} ', &
'<1 1 . 6>{-1 -1 . 1}', &
'<1 0 . -2>{1 0 . 1} ', &
'<1 1 . -3>{1 1 . 2} ']
integer(pInt), dimension(LATTICE_hex_Ntwin), parameter, private :: &
LATTICE_hex_shearTwin = reshape(int( [& ! indicator to formula further below
1, & ! <-10.1>{10.2}
@ -844,17 +871,17 @@ module lattice
LATTICE_bct_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for bct
integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: &
LATTICE_bct_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for bct
LATTICE_bct_NtransSystem = int([0],pInt) !< # of transformation systems per family for bct
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: &
LATTICE_bct_NcleavageSystem = int([0, 0, 0],pInt) !< # of cleavage systems per family for bct
integer(pInt), parameter, private :: &
LATTICE_bct_Nslip = 52_pInt, & !sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct
LATTICE_bct_Ntwin = 0_pInt, & !sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct
LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct
LATTICE_bct_Ntwin = sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct
LATTICE_bct_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for bct
LATTICE_bct_Ntrans = 0_pInt, & !sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct
LATTICE_bct_Ncleavage = 0_pInt !sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct
LATTICE_bct_Ntrans = sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct
LATTICE_bct_Ncleavage = sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct
real(pReal), dimension(3+3,LATTICE_bct_Nslip), parameter, private :: &
LATTICE_bct_systemSlip = reshape(real([&
@ -926,6 +953,21 @@ module lattice
1, 1, 1, 1,-2, 1 &
],pReal),[ 3_pInt + 3_pInt,LATTICE_bct_Nslip]) !< slip systems for bct sorted by Bieler
character(len=*), dimension(13), parameter, public :: LATTICE_BCT_SLIPFAMILY_NAME = &
['{1 0 0)<0 0 1] ', &
'{1 1 0)<0 0 1] ', &
'{1 0 0)<0 1 0] ', &
'{1 1 0)<1 -1 1]', &
'{1 1 0)<1 -1 0]', &
'{1 0 0)<0 1 1] ', &
'{0 0 1)<0 1 0] ', &
'{0 0 1)<1 1 0] ', &
'{0 1 1)<0 1 -1]', &
'{0 1 1)<1 -1 1]', &
'{0 1 1)<1 0 0] ', &
'{2 1 1)<0 1 -1]', &
'{2 1 1)<-1 1 1]']
integer(pInt), dimension(LATTICE_bct_Nslip,LATTICE_bct_Nslip), parameter, public :: &
LATTICE_bct_interactionSlipSlip = reshape(int( [&
1, 2, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, &
@ -1004,17 +1046,17 @@ module lattice
LATTICE_iso_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for iso
integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: &
LATTICE_iso_NtransSystem = int([0, 0],pInt) !< # of transformation systems per family for iso
LATTICE_iso_NtransSystem = int([0],pInt) !< # of transformation systems per family for iso
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: &
LATTICE_iso_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for iso
integer(pInt), parameter, private :: &
LATTICE_iso_Nslip = 0_pInt, & !sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso
LATTICE_iso_Ntwin = 0_pInt, & !sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso
LATTICE_iso_Nslip = sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso
LATTICE_iso_Ntwin = sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso
LATTICE_iso_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for iso
LATTICE_iso_Ntrans = 0_pInt, & !sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso
LATTICE_iso_Ncleavage = 3_pInt !sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso
LATTICE_iso_Ntrans = sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso
LATTICE_iso_Ncleavage = sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso
real(pReal), dimension(3+3,LATTICE_iso_Ncleavage), parameter, private :: &
LATTICE_iso_systemCleavage = reshape(real([&
@ -1033,17 +1075,17 @@ module lattice
LATTICE_ortho_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for ortho
integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: &
LATTICE_ortho_NtransSystem = int([0, 0],pInt) !< # of transformation systems per family for ortho
LATTICE_ortho_NtransSystem = int([0],pInt) !< # of transformation systems per family for ortho
integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: &
LATTICE_ortho_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho
integer(pInt), parameter, private :: &
LATTICE_ortho_Nslip = 0_pInt, & !sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho
LATTICE_ortho_Ntwin = 0_pInt, & !sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho
LATTICE_ortho_Nslip = sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho
LATTICE_ortho_Ntwin = sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho
LATTICE_ortho_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for ortho
LATTICE_ortho_Ntrans = 0_pInt, & !sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho
LATTICE_ortho_Ncleavage = 3_pInt !sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho
LATTICE_ortho_Ntrans = sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho
LATTICE_ortho_Ncleavage = sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho
real(pReal), dimension(3+3,LATTICE_ortho_Ncleavage), parameter, private :: &
LATTICE_ortho_systemCleavage = reshape(real([&
@ -1054,25 +1096,44 @@ module lattice
],pReal),[ 3_pInt + 3_pInt,LATTICE_ortho_Ncleavage])
integer(pInt), parameter, public :: &
LATTICE_maxNslip = 52_pInt, &
!LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip,\
! LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures
LATTICE_maxNtwin = 24_pInt, &
!LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin,\
! LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures
LATTICE_maxNnonSchmid = 6_pInt, &
!LATTICE_maxNtwin = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid,\
! LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid,\
! LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures
LATTICE_maxNtrans = 12_pInt, &
!LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans,\
! LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]),&!< max # of transformation systems over lattice structures
LATTICE_maxNcleavage = 9_pInt, &
!LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage,\
! LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage,\
! LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]) !< max # of cleavage systems over lattice structures
LATTICE_maxNinteraction = 182_pInt !< max # of interaction types (in hardening matrix part)
LATTICE_maxNslip = max(LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, &
LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip), & !< max # of slip systems over lattice structures
LATTICE_maxNtwin = max(LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, &
LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin), & !< max # of twin systems over lattice structures
LATTICE_maxNnonSchmid = max(LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, &
LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, &
LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid), & !< max # of non-Schmid contributions over lattice structures
LATTICE_maxNtrans = max(LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, &
LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans), & !< max # of transformation systems over lattice structures
LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, &
LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, &
LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage), & !< max # of cleavage systems over lattice structures
#if defined(__GFORTRAN__)
! only supported in gcc 8
LATTICE_maxNinteraction = 182_pInt
#else
LATTICE_maxNinteraction = max(&
maxval(lattice_fcc_interactionSlipSlip), &
maxval(lattice_bcc_interactionSlipSlip), &
maxval(lattice_hex_interactionSlipSlip), &
maxval(lattice_bct_interactionSlipSlip), &
!
maxval(lattice_fcc_interactionSlipTwin), &
maxval(lattice_bcc_interactionSlipTwin), &
maxval(lattice_hex_interactionSlipTwin), &
!maxval(lattice_bct_interactionSlipTwin), &
!
maxval(lattice_fcc_interactionTwinSlip), &
maxval(lattice_bcc_interactionTwinSlip), &
maxval(lattice_hex_interactionTwinSlip), &
!maxval(lattice_bct_interactionTwinSlip), &
!
maxval(lattice_fcc_interactionTwinTwin), &
maxval(lattice_bcc_interactionTwinTwin), &
maxval(lattice_hex_interactionTwinTwin) &
!maxval(lattice_bct_interactionTwinTwin)))
) !< max # of interaction types (in hardening matrix part)
#endif
real(pReal), dimension(:,:,:), allocatable, public, protected :: &
lattice_C66, lattice_trans_C66
real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: &
@ -1250,38 +1311,19 @@ subroutine lattice_init
compiler_options
#endif
use IO, only: &
IO_open_file,&
IO_open_jobFile_stat, &
IO_countSections, &
IO_error, &
IO_timeStamp, &
IO_EOF, &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue
IO_timeStamp
use config, only: &
material_configfile, &
material_localFileExt, &
material_partPhase
use debug, only: &
debug_level, &
debug_lattice, &
debug_levelBasic
config_phase
implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt) :: Nphases
character(len=65536) :: &
tag = '', &
line = ''
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: section = 0_pInt,i
tag = ''
integer(pInt) :: i,p
real(pReal), dimension(:), allocatable :: &
CoverA, & !!!!!!< c/a ratio for low symmetry type lattice
temp, &
CoverA, & !< c/a ratio for low symmetry type lattice
CoverA_trans, & !< c/a ratio for transformed hex type lattice
a_fcc, & !< lattice parameter a for fcc austenite
a_bcc !< lattice paramater a for bcc martensite
@ -1290,90 +1332,7 @@ subroutine lattice_init
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
!--------------------------------------------------------------------------------------------------
! consistency checks (required since ifort 15.0 does not support sum/maxval in parameter definition)
if (LATTICE_maxNslip /= maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip,LATTICE_bct_Nslip])) &
call IO_error(0_pInt,ext_msg = 'LATTICE_maxNslip')
if (LATTICE_maxNtwin /= maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin])) &
call IO_error(0_pInt,ext_msg = 'LATTICE_maxNtwin')
if (LATTICE_maxNtrans /= maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans])) &
call IO_error(0_pInt,ext_msg = 'LATTICE_maxNtrans')
if (LATTICE_maxNnonSchmid /= maxval([lattice_fcc_NnonSchmid,lattice_bcc_NnonSchmid,&
lattice_hex_NnonSchmid])) call IO_error(0_pInt,ext_msg = 'LATTICE_maxNnonSchmid')
if (LATTICE_fcc_Nslip /= sum(lattice_fcc_NslipSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Nslip')
if (LATTICE_bcc_Nslip /= sum(lattice_bcc_NslipSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Nslip')
if (LATTICE_hex_Nslip /= sum(lattice_hex_NslipSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Nslip')
if (LATTICE_bct_Nslip /= sum(lattice_bct_NslipSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Nslip')
if (LATTICE_fcc_Ntwin /= sum(lattice_fcc_NtwinSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ntwin')
if (LATTICE_bcc_Ntwin /= sum(lattice_bcc_NtwinSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ntwin')
if (LATTICE_hex_Ntwin /= sum(lattice_hex_NtwinSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ntwin')
if (LATTICE_bct_Ntwin /= sum(lattice_bct_NtwinSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ntwin')
if (LATTICE_fcc_Ntrans /= sum(lattice_fcc_NtransSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ntrans')
if (LATTICE_bcc_Ntrans /= sum(lattice_bcc_NtransSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ntrans')
if (LATTICE_hex_Ntrans /= sum(lattice_hex_NtransSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ntrans')
if (LATTICE_bct_Ntrans /= sum(lattice_bct_NtransSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ntrans')
if (LATTICE_fcc_Ncleavage /= sum(lattice_fcc_NcleavageSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ncleavage')
if (LATTICE_bcc_Ncleavage /= sum(lattice_bcc_NcleavageSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ncleavage')
if (LATTICE_hex_Ncleavage /= sum(lattice_hex_NcleavageSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ncleavage')
if (LATTICE_bct_Ncleavage /= sum(lattice_bct_NcleavageSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ncleavage')
if (LATTICE_iso_Ncleavage /= sum(lattice_iso_NcleavageSystem)) &
call IO_error(0_pInt,ext_msg = 'LATTICE_iso_Ncleavage')
if (LATTICE_maxNinteraction /= max(&
maxval(lattice_fcc_interactionSlipSlip), &
maxval(lattice_bcc_interactionSlipSlip), &
maxval(lattice_hex_interactionSlipSlip), &
maxval(lattice_bct_interactionSlipSlip), &
!
maxval(lattice_fcc_interactionSlipTwin), &
maxval(lattice_bcc_interactionSlipTwin), &
maxval(lattice_hex_interactionSlipTwin), &
! maxval(lattice_bct_interactionSlipTwin), &
!
maxval(lattice_fcc_interactionTwinSlip), &
maxval(lattice_bcc_interactionTwinSlip), &
maxval(lattice_hex_interactionTwinSlip), &
! maxval(lattice_bct_interactionTwinSlip), &
!
maxval(lattice_fcc_interactionTwinTwin), &
maxval(lattice_bcc_interactionTwinTwin), &
maxval(lattice_hex_interactionTwinTwin))) &
! maxval(lattice_bct_interactionTwinTwin))) &
call IO_error(0_pInt,ext_msg = 'LATTICE_maxNinteraction')
!--------------------------------------------------------------------------------------------------
! read from material configuration file
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file
Nphases = IO_countSections(FILEUNIT,material_partPhase)
if(Nphases<1_pInt) &
call IO_error(160_pInt,Nphases, ext_msg='No phases found')
if (iand(debug_level(debug_lattice),debug_levelBasic) /= 0_pInt) then
write(6,'(a16,1x,i5)') ' # phases:',Nphases
endif
Nphases = size(config_phase)
allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID)
allocate(trans_lattice_structure(Nphases),source = LATTICE_undefined_ID)
@ -1450,177 +1409,99 @@ subroutine lattice_init
allocate(a_fcc(Nphases),source=0.0_pReal)
allocate(a_bcc(Nphases),source=0.0_pReal)
rewind(fileUnit)
line = '' ! to have it initialized
section = 0_pInt ! - " -
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to <Phase>
line = IO_read(fileUnit)
enddo
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt
endif
if (section > 0_pInt) then
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('lattice_structure')
select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt))))
do p = 1, size(config_phase)
tag = config_phase(p)%getString('lattice_structure')
select case(trim(tag))
case('iso','isotropic')
lattice_structure(section) = LATTICE_iso_ID
lattice_structure(p) = LATTICE_iso_ID
case('fcc')
lattice_structure(section) = LATTICE_fcc_ID
lattice_structure(p) = LATTICE_fcc_ID
case('bcc')
lattice_structure(section) = LATTICE_bcc_ID
lattice_structure(p) = LATTICE_bcc_ID
case('hex','hexagonal')
lattice_structure(section) = LATTICE_hex_ID
lattice_structure(p) = LATTICE_hex_ID
case('bct')
lattice_structure(section) = LATTICE_bct_ID
lattice_structure(p) = LATTICE_bct_ID
case('ort','orthorhombic')
lattice_structure(section) = LATTICE_ort_ID
case default
call IO_error(130_pInt,ext_msg=trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt))))
lattice_structure(p) = LATTICE_ort_ID
end select
case('trans_lattice_structure')
select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt))))
tag = 'undefined'
tag = config_phase(p)%getString('trans_lattice_structure',defaultVal=tag)
select case(trim(tag))
case('bcc')
trans_lattice_structure(section) = LATTICE_bcc_ID
case('hex','hexagonal','hcp')
trans_lattice_structure(section) = LATTICE_hex_ID
trans_lattice_structure(p) = LATTICE_bcc_ID
case('hex','hexagonal')
trans_lattice_structure(p) = LATTICE_hex_ID
end select
case ('c11')
lattice_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c12')
lattice_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c13')
lattice_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c22')
lattice_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c23')
lattice_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c33')
lattice_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c44')
lattice_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c55')
lattice_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c66')
lattice_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c11_trans')
lattice_trans_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c12_trans')
lattice_trans_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c13_trans')
lattice_trans_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c22_trans')
lattice_trans_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c23_trans')
lattice_trans_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c33_trans')
lattice_trans_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c44_trans')
lattice_trans_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c55_trans')
lattice_trans_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c66_trans')
lattice_trans_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('covera_ratio','c/a_ratio','c/a')
CoverA(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('c/a_trans','c/a_martensite','c/a_mart')
CoverA_trans(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('a_fcc')
a_fcc(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('a_bcc')
a_bcc(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('thermal_conductivity11')
lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('thermal_conductivity22')
lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('thermal_conductivity33')
lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('thermal_expansion11')
do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T)
lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i)
enddo
case ('thermal_expansion22')
do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T)
lattice_thermalExpansion33(2,2,i-1_pInt,section) = IO_floatValue(line,chunkPos,i)
enddo
case ('thermal_expansion33')
do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T)
lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i)
enddo
case ('specific_heat')
lattice_specificHeat(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancyformationenergy')
lattice_vacancyFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancysurfaceenergy')
lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancyvolume')
lattice_vacancyVol(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogenformationenergy')
lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogensurfaceenergy')
lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogenvolume')
lattice_hydrogenVol(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('mass_density')
lattice_massDensity(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('reference_temperature')
lattice_referenceTemperature(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('damage_diffusion11')
lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('damage_diffusion22')
lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('damage_diffusion33')
lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('damage_mobility')
lattice_DamageMobility(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancyflux_diffusion11')
lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancyflux_diffusion22')
lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancyflux_diffusion33')
lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancyflux_mobility11')
lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancyflux_mobility22')
lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancyflux_mobility33')
lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('porosity_diffusion11')
lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('porosity_diffusion22')
lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('porosity_diffusion33')
lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('porosity_mobility')
lattice_PorosityMobility(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogenflux_diffusion11')
lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogenflux_diffusion22')
lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogenflux_diffusion33')
lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogenflux_mobility11')
lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogenflux_mobility22')
lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogenflux_mobility33')
lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt)
case ('vacancy_eqcv')
lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,chunkPos,2_pInt)
case ('hydrogen_eqch')
lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,chunkPos,2_pInt)
end select
endif
lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal)
lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal)
lattice_C66(1,3,p) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal)
lattice_C66(2,2,p) = config_phase(p)%getFloat('c22',defaultVal=0.0_pReal)
lattice_C66(2,3,p) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal)
lattice_C66(3,3,p) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal)
lattice_C66(4,4,p) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal)
lattice_C66(5,5,p) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal)
lattice_C66(6,6,p) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal)
lattice_trans_C66(1,1,p) = config_phase(p)%getFloat('c11_trans',defaultVal=0.0_pReal)
lattice_trans_C66(1,2,p) = config_phase(p)%getFloat('c12_trans',defaultVal=0.0_pReal)
lattice_trans_C66(1,3,p) = config_phase(p)%getFloat('c13_trans',defaultVal=0.0_pReal)
lattice_trans_C66(2,2,p) = config_phase(p)%getFloat('c22_trans',defaultVal=0.0_pReal)
lattice_trans_C66(2,3,p) = config_phase(p)%getFloat('c23_trans',defaultVal=0.0_pReal)
lattice_trans_C66(3,3,p) = config_phase(p)%getFloat('c33_trans',defaultVal=0.0_pReal)
lattice_trans_C66(4,4,p) = config_phase(p)%getFloat('c44_trans',defaultVal=0.0_pReal)
lattice_trans_C66(5,5,p) = config_phase(p)%getFloat('c55_trans',defaultVal=0.0_pReal)
lattice_trans_C66(6,6,p) = config_phase(p)%getFloat('c66_trans',defaultVal=0.0_pReal)
CoverA(p) = config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal)
CoverA_trans(p) = config_phase(p)%getFloat('c/a_trans',defaultVal=0.0_pReal)
a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal)
a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal)
lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11',defaultVal=0.0_pReal)
lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22',defaultVal=0.0_pReal)
lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33',defaultVal=0.0_pReal)
temp = config_phase(p)%getFloats('thermal_expansion11',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T)
lattice_thermalExpansion33(1,1,1:size(temp),p) = temp
temp = config_phase(p)%getFloats('thermal_expansion22',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T)
lattice_thermalExpansion33(2,2,1:size(temp),p) = temp
temp = config_phase(p)%getFloats('thermal_expansion33',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T)
lattice_thermalExpansion33(3,3,1:size(temp),p) = temp
lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal)
lattice_vacancyFormationEnergy(p) = config_phase(p)%getFloat( 'vacancyformationenergy',defaultVal=0.0_pReal)
lattice_vacancySurfaceEnergy(p) = config_phase(p)%getFloat( 'vacancyvolume',defaultVal=0.0_pReal)
lattice_vacancyVol(p) = config_phase(p)%getFloat( 'vacancysurfaceenergy',defaultVal=0.0_pReal)
lattice_hydrogenFormationEnergy(p) = config_phase(p)%getFloat( 'hydrogenformationenergy',defaultVal=0.0_pReal)
lattice_hydrogenSurfaceEnergy(p) = config_phase(p)%getFloat( 'hydrogensurfaceenergy',defaultVal=0.0_pReal)
lattice_hydrogenVol(p) = config_phase(p)%getFloat( 'hydrogenvolume',defaultVal=0.0_pReal)
lattice_massDensity(p) = config_phase(p)%getFloat( 'mass_density',defaultVal=0.0_pReal)
lattice_referenceTemperature(p) = config_phase(p)%getFloat( 'reference_temperature',defaultVal=0.0_pReal)
lattice_DamageDiffusion33(1,1,p) = config_phase(p)%getFloat( 'damage_diffusion11',defaultVal=0.0_pReal)
lattice_DamageDiffusion33(2,2,p) = config_phase(p)%getFloat( 'damage_diffusion22',defaultVal=0.0_pReal)
lattice_DamageDiffusion33(3,3,p) = config_phase(p)%getFloat( 'damage_diffusion33',defaultVal=0.0_pReal)
lattice_DamageMobility(p) = config_phase(p)%getFloat( 'damage_mobility',defaultVal=0.0_pReal)
lattice_vacancyfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion11',defaultVal=0.0_pReal)
lattice_vacancyfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion22',defaultVal=0.0_pReal)
lattice_vacancyfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion33',defaultVal=0.0_pReal)
lattice_vacancyfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_mobility11',defaultVal=0.0_pReal)
lattice_vacancyfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_mobility22',defaultVal=0.0_pReal)
lattice_vacancyfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_mobility33',defaultVal=0.0_pReal)
lattice_PorosityDiffusion33(1,1,p) = config_phase(p)%getFloat( 'porosity_diffusion11',defaultVal=0.0_pReal)
lattice_PorosityDiffusion33(2,2,p) = config_phase(p)%getFloat( 'porosity_diffusion22',defaultVal=0.0_pReal)
lattice_PorosityDiffusion33(3,3,p) = config_phase(p)%getFloat( 'porosity_diffusion33',defaultVal=0.0_pReal)
lattice_PorosityMobility(p) = config_phase(p)%getFloat( 'porosity_mobility',defaultVal=0.0_pReal)
lattice_hydrogenfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion11',defaultVal=0.0_pReal)
lattice_hydrogenfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion22',defaultVal=0.0_pReal)
lattice_hydrogenfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion33',defaultVal=0.0_pReal)
lattice_hydrogenfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility11',defaultVal=0.0_pReal)
lattice_hydrogenfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility22',defaultVal=0.0_pReal)
lattice_hydrogenfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility33',defaultVal=0.0_pReal)
lattice_equilibriumVacancyConcentration(p) = config_phase(p)%getFloat( 'vacancy_eqcv',defaultVal=0.0_pReal)
lattice_equilibriumHydrogenConcentration(p) = config_phase(p)%getFloat( 'hydrogen_eqch',defaultVal=0.0_pReal)
enddo
do i = 1_pInt,Nphases
@ -1631,8 +1512,6 @@ subroutine lattice_init
call lattice_initializeStructure(i, CoverA(i), CoverA_trans(i), a_fcc(i), a_bcc(i))
enddo
deallocate(CoverA,CoverA_trans,a_fcc,a_bcc)
end subroutine lattice_init

20
src/material.f90
View File

@ -16,8 +16,8 @@ module material
tSourceState, &
tHomogMapping, &
tPhaseMapping, &
p_vec, &
p_intvec
group_float, &
group_int
implicit none
private
@ -268,7 +268,7 @@ module material
porosityMapping, & !< mapping for porosity state/fields
hydrogenfluxMapping !< mapping for hydrogen conc state/fields
type(p_vec), allocatable, dimension(:), public :: &
type(group_float), allocatable, dimension(:), public :: &
temperature, & !< temperature field
damage, & !< damage field
vacancyConc, & !< vacancy conc field
@ -360,8 +360,7 @@ subroutine material_init()
homogenization_name, &
microstructure_name, &
phase_name, &
texture_name, &
config_deallocate
texture_name
use mesh, only: &
mesh_maxNips, &
mesh_NcpElems, &
@ -370,7 +369,7 @@ subroutine material_init()
FE_geomtype
implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt), parameter :: FILEUNIT = 210_pInt
integer(pInt) :: m,c,h, myDebug, myPhase, myHomog
integer(pInt) :: &
g, & !< grain number
@ -469,7 +468,6 @@ subroutine material_init()
endif debugOut
call material_populateGrains
call config_deallocate('material.config/microstructure')
allocate(phaseAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt)
allocate(phasememberAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt)
@ -921,8 +919,8 @@ subroutine material_parseTexture
IO_floatValue, &
IO_stringValue
use config, only: &
config_texture, &
config_deallocate
config_deallocate, &
config_texture
use math, only: &
inRad, &
math_sampleRandomOri, &
@ -1093,6 +1091,7 @@ subroutine material_populateGrains
use config, only: &
config_homogenization, &
config_microstructure, &
config_deallocate, &
homogenization_name, &
microstructure_name
use IO, only: &
@ -1121,7 +1120,7 @@ subroutine material_populateGrains
grain,constituentGrain,ipGrain,symExtension, ip
real(pReal) :: deviation,extreme,rnd
integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array
type(p_intvec), 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)
@ -1429,6 +1428,7 @@ subroutine material_populateGrains
deallocate(texture_transformation)
deallocate(Nelems)
deallocate(elemsOfHomogMicro)
call config_deallocate('material.config/microstructure')
end subroutine material_populateGrains

4
src/math.f90
View File

@ -378,8 +378,10 @@ pure function math_expand(what,how)
integer(pInt), dimension(:), intent(in) :: how
real(pReal), dimension(sum(how)) :: math_expand
integer(pInt) :: i
if(sum(how)==0) &
if (sum(how) == 0_pInt) &
return
do i = 1_pInt, size(how)
math_expand(sum(how(1:i-1))+1:sum(how(1:i))) = what(mod(i-1_pInt,size(what))+1_pInt)
enddo

33
src/mesh.f90
View File

@ -95,9 +95,11 @@ module mesh
integer(pInt), dimension(:,:), allocatable, private :: &
mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID
#if defined(Marc4DAMASK) || defined(Abaqus)
integer(pInt), dimension(:,:), allocatable, target, private :: &
mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid]
mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid]
#endif
integer(pInt),dimension(:,:,:), allocatable, private :: &
mesh_cell !< cell connectivity for each element,ip/cell
@ -402,7 +404,9 @@ module mesh
public :: &
mesh_init, &
#if defined(Marc4DAMASK) || defined(Abaqus)
mesh_FEasCP, &
#endif
mesh_build_cellnodes, &
mesh_build_ipVolumes, &
mesh_build_ipCoordinates, &
@ -420,7 +424,6 @@ module mesh
#ifdef Spectral
mesh_spectral_getHomogenization, &
mesh_spectral_count, &
mesh_spectral_mapNodesAndElems, &
mesh_spectral_count_cpSizes, &
mesh_spectral_build_nodes, &
mesh_spectral_build_elements, &
@ -552,8 +555,6 @@ subroutine mesh_init(ip,el)
if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6)
call mesh_spectral_count()
if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6)
call mesh_spectral_mapNodesAndElems
if (myDebug) write(6,'(a)') ' Mapped nodes and elements'; flush(6)
call mesh_spectral_count_cpSizes
if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6)
call mesh_spectral_build_nodes()
@ -659,12 +660,16 @@ subroutine mesh_init(ip,el)
allocate(calcMode(mesh_maxNips,mesh_NcpElems))
calcMode = .false. ! pretend to have collected what first call is asking (F = I)
#if defined(Marc4DAMASK) || defined(Abaqus)
calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc"
#else
calcMode(ip,el) = .true. ! first ip,el needs to be already pingponged to "calc"
#endif
end subroutine mesh_init
#if defined(Marc4DAMASK) || defined(Abaqus)
!--------------------------------------------------------------------------------------------------
!> @brief Gives the FE to CP ID mapping by binary search through lookup array
!! valid questions (what) are 'elem', 'node'
@ -713,7 +718,7 @@ integer(pInt) function mesh_FEasCP(what,myID)
enddo binarySearch
end function mesh_FEasCP
#endif
!--------------------------------------------------------------------------------------------------
!> @brief Split CP elements into cells.
@ -1188,24 +1193,6 @@ subroutine mesh_spectral_count()
end subroutine mesh_spectral_count
!--------------------------------------------------------------------------------------------------
!> @brief fake map node from FE ID to internal (consecutive) representation for node and element
!! Allocates global array 'mesh_mapFEtoCPnode' and 'mesh_mapFEtoCPelem'
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_mapNodesAndElems
use math, only: &
math_range
implicit none
allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source = 0_pInt)
allocate (mesh_mapFEtoCPelem(2_pInt,mesh_NcpElems), source = 0_pInt)
mesh_mapFEtoCPnode = spread(math_range(mesh_Nnodes),1,2)
mesh_mapFEtoCPelem = spread(math_range(mesh_NcpElems),1,2)
end subroutine mesh_spectral_mapNodesAndElems
!--------------------------------------------------------------------------------------------------
!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements.
!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors',

356
src/meshFEM.f90 Normal file
View File

@ -0,0 +1,356 @@
!--------------------------------------------------------------------------------------------------
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Driver controlling inner and outer load case looping of the FEM solver
!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing
!> results
!--------------------------------------------------------------------------------------------------
module mesh
#include <petsc/finclude/petscis.h>
#include <petsc/finclude/petscdmda.h>
use prec, only: pReal, pInt
use PETScdmda
use PETScis
implicit none
private
integer(pInt), public, protected :: &
mesh_Nboundaries, &
mesh_NcpElems, & !< total number of CP elements in mesh
mesh_NcpElemsGlobal, &
mesh_Nnodes, & !< total number of nodes in mesh
mesh_maxNnodes, & !< max number of nodes in any CP element
mesh_maxNips, & !< max number of IPs in any CP element
mesh_maxNipNeighbors, &
mesh_Nelems !< total number of elements in mesh
real(pReal), public, protected :: charLength
integer(pInt), dimension(:,:), allocatable, public, protected :: &
mesh_element !< FEid, type(internal representation), material, texture, node indices as CP IDs
real(pReal), dimension(:,:), allocatable, public :: &
mesh_node !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!)
real(pReal), dimension(:,:), allocatable, public, protected :: &
mesh_ipVolume, & !< volume associated with IP (initially!)
mesh_node0 !< node x,y,z coordinates (initially!)
real(pReal), dimension(:,:,:), allocatable, public :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
real(pReal), dimension(:,:,:), allocatable, public, protected :: &
mesh_ipArea !< area of interface to neighboring IP (initially!)
real(pReal),dimension(:,:,:,:), allocatable, public, protected :: &
mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!)
integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: &
mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes)
DM, public :: geomMesh
integer(pInt), dimension(:), allocatable, public, protected :: &
mesh_boundaries
integer(pInt), parameter, public :: &
FE_Nelemtypes = 1_pInt, &
FE_Ngeomtypes = 1_pInt, &
FE_Ncelltypes = 1_pInt, &
FE_maxNnodes = 1_pInt, &
FE_maxNips = 14_pInt
integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type
int([1],pInt)
integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type
int([1],pInt)
integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element
int([0],pInt)
integer(pInt), dimension(FE_Ngeomtypes), public :: FE_Nips = & !< number of IPs in a specific type of element
int([0],pInt)
integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type
int([6],pInt)
public :: &
mesh_init, &
mesh_FEM_build_ipVolumes, &
mesh_FEM_build_ipCoordinates, &
mesh_cellCenterCoordinates
external :: &
DMPlexCreateFromFile, &
DMPlexDistribute, &
DMPlexCopyCoordinates, &
DMGetStratumSize, &
DMPlexGetHeightStratum, &
DMPlexGetLabelValue, &
DMPlexSetLabelValue
contains
!--------------------------------------------------------------------------------------------------
!> @brief initializes the mesh by calling all necessary private routines the mesh module
!! Order and routines strongly depend on type of solver
!--------------------------------------------------------------------------------------------------
subroutine mesh_init(ip,el)
use DAMASK_interface
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
use IO, only: &
IO_timeStamp, &
IO_error, &
IO_open_file, &
IO_stringPos, &
IO_intValue, &
IO_EOF, &
IO_read, &
IO_isBlank
use debug, only: &
debug_e, &
debug_i
use numerics, only: &
usePingPong, &
integrationOrder, &
worldrank, &
worldsize
use FEsolving, only: &
FEsolving_execElem, &
FEsolving_execIP, &
calcMode
use FEM_Zoo, only: &
FEM_Zoo_nQuadrature, &
FEM_Zoo_QuadraturePoints
implicit none
integer(pInt), parameter :: FILEUNIT = 222_pInt
integer(pInt), intent(in) :: el, ip
integer(pInt) :: j
integer(pInt), allocatable, dimension(:) :: chunkPos
integer :: dimPlex
character(len=512) :: &
line
logical :: flag
PetscSF :: sf
DM :: globalMesh
PetscInt :: face, nFaceSets
PetscInt, pointer :: pFaceSets(:)
IS :: faceSetIS
PetscErrorCode :: ierr
write(6,'(/,a)') ' <<<+- mesh init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr)
CHKERRQ(ierr)
call DMGetDimension(globalMesh,dimPlex,ierr)
CHKERRQ(ierr)
call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr)
CHKERRQ(ierr)
call DMGetLabelSize(globalMesh,'Face Sets',mesh_Nboundaries,ierr)
CHKERRQ(ierr)
call MPI_Bcast(mesh_Nboundaries,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
allocate(mesh_boundaries(mesh_Nboundaries), source = 0_pInt)
call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr)
CHKERRQ(ierr)
call DMGetLabelIdIS(globalMesh,'Face Sets',faceSetIS,ierr)
CHKERRQ(ierr)
if (nFaceSets > 0) call ISGetIndicesF90(faceSetIS,pFaceSets,ierr)
do face = 1, nFaceSets
mesh_boundaries(face) = pFaceSets(face)
enddo
if (nFaceSets > 0) call ISRestoreIndicesF90(faceSetIS,pFaceSets,ierr)
call MPI_Bcast(mesh_boundaries,mesh_Nboundaries,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
if (worldrank == 0) then
j = 0
flag = .false.
call IO_open_file(FILEUNIT,trim(geometryFile))
do
read(FILEUNIT,'(a512)') line
if (trim(line) == IO_EOF) exit ! skip empty lines
if (trim(line) == '$Elements') then
read(FILEUNIT,'(a512)') line
read(FILEUNIT,'(a512)') line
flag = .true.
endif
if (trim(line) == '$EndElements') exit
if (flag) then
chunkPos = IO_stringPos(line)
if (chunkPos(1) == 3+IO_intValue(line,chunkPos,3)+dimPlex+1) then
call DMSetLabelValue(globalMesh,'material',j,IO_intValue(line,chunkPos,4),ierr)
CHKERRQ(ierr)
j = j + 1
endif ! count all identifiers to allocate memory and do sanity check
endif
enddo
close (FILEUNIT)
endif
if (worldsize > 1) then
call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr)
CHKERRQ(ierr)
else
call DMClone(globalMesh,geomMesh,ierr)
CHKERRQ(ierr)
endif
call DMDestroy(globalMesh,ierr); CHKERRQ(ierr)
call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_Nelems,ierr)
CHKERRQ(ierr)
call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr)
CHKERRQ(ierr)
mesh_NcpElems = mesh_Nelems
FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder)
mesh_maxNnodes = FE_Nnodes(1_pInt)
mesh_maxNips = FE_Nips(1_pInt)
call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p)
call mesh_FEM_build_ipVolumes(dimPlex)
allocate (mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems)); mesh_element = 0_pInt
do j = 1, mesh_NcpElems
mesh_element( 1,j) = j
mesh_element( 2,j) = 1_pInt ! elem type
mesh_element( 3,j) = 1_pInt ! homogenization
call DMGetLabelValue(geomMesh,'material',j-1,mesh_element(4,j),ierr)
CHKERRQ(ierr)
end do
if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) &
call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements
if (debug_e < 1 .or. debug_e > mesh_NcpElems) &
call IO_error(602_pInt,ext_msg='element') ! selected element does not exist
if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) &
call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP
FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements
if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP)
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
if (allocated(calcMode)) deallocate(calcMode)
allocate(calcMode(mesh_maxNips,mesh_NcpElems))
calcMode = .false. ! pretend to have collected what first call is asking (F = I)
calcMode(ip,el) = .true. ! first ip,el needs to be already pingponged to "calc"
end subroutine mesh_init
!--------------------------------------------------------------------------------------------------
!> @brief Calculates cell center coordinates.
!--------------------------------------------------------------------------------------------------
pure function mesh_cellCenterCoordinates(ip,el)
implicit none
integer(pInt), intent(in) :: el, & !< element number
ip !< integration point number
real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell
end function mesh_cellCenterCoordinates
!--------------------------------------------------------------------------------------------------
!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume'
!> @details The IP volume is calculated differently depending on the cell type.
!> 2D cells assume an element depth of one in order to calculate the volume.
!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal
!> shape with a cell face as basis and the central ip at the tip. This subvolume is
!> calculated as an average of four tetrahedals with three corners on the cell face
!> and one corner at the central ip.
!--------------------------------------------------------------------------------------------------
subroutine mesh_FEM_build_ipVolumes(dimPlex)
use math, only: &
math_I3, &
math_det33
implicit none
PetscInt :: dimPlex
PetscReal :: vol
PetscReal, target :: cent(dimPlex), norm(dimPlex)
PetscReal, pointer :: pCent(:), pNorm(:)
PetscInt :: cellStart, cellEnd, cell
PetscErrorCode :: ierr
if (.not. allocated(mesh_ipVolume)) then
allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems))
mesh_ipVolume = 0.0_pReal
endif
call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr)
pCent => cent
pNorm => norm
do cell = cellStart, cellEnd-1
call DMPlexComputeCellGeometryFVM(geomMesh,cell,vol,pCent,pNorm,ierr)
CHKERRQ(ierr)
mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pReal)
enddo
end subroutine mesh_FEM_build_ipVolumes
!--------------------------------------------------------------------------------------------------
!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates'
! Called by all solvers in mesh_init in order to initialize the ip coordinates.
! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus,
! so no need to use this subroutine anymore; Marc however only provides nodal displacements,
! so in this case the ip coordinates are always calculated on the basis of this subroutine.
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES,
! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME.
! HAS TO BE CHANGED IN A LATER VERSION.
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!--------------------------------------------------------------------------------------------------
subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints)
implicit none
PetscInt, intent(in) :: dimPlex
PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex)
PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex)
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
PetscReal :: detJ
PetscInt :: cellStart, cellEnd, cell, qPt, dirI, dirJ, qOffset
PetscErrorCode :: ierr
allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal)
pV0 => v0
pCellJ => cellJ
pInvcellJ => invcellJ
call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr)
do cell = cellStart, cellEnd-1 !< loop over all elements
call DMPlexComputeCellGeometryAffineFEM(geomMesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr)
CHKERRQ(ierr)
qOffset = 0
do qPt = 1, mesh_maxNips
do dirI = 1, dimPlex
mesh_ipCoordinates(dirI,qPt,cell+1) = pV0(dirI)
do dirJ = 1, dimPlex
mesh_ipCoordinates(dirI,qPt,cell+1) = mesh_ipCoordinates(dirI,qPt,cell+1) + &
pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0)
enddo
enddo
qOffset = qOffset + dimPlex
enddo
enddo
end subroutine mesh_FEM_build_ipCoordinates
end module mesh

14
src/numerics.f90
View File

@ -16,7 +16,6 @@ module numerics
integer(pInt), protected, public :: &
iJacoStiffness = 1_pInt, & !< frequency of stiffness update
iJacoLpresiduum = 1_pInt, & !< frequency of Jacobian update of residuum in Lp
nHomog = 20_pInt, & !< homogenization loop limit (only for debugging info, loop limit is determined by "subStepMinHomog")
nMPstate = 10_pInt, & !< materialpoint state loop limit
nCryst = 20_pInt, & !< crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst")
nState = 10_pInt, & !< state loop limit
@ -27,8 +26,7 @@ module numerics
worldsize = 0_pInt !< MPI worldsize (/=0 for MPI simulations only)
integer(4), protected, public :: &
DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive
integer(pInt), public :: &
numerics_integrationMode = 0_pInt !< integrationMode 1 = central solution; integrationMode 2 = perturbation, Default 0: undefined, is not read from file
!< ToDo: numerics_integrator is an array for historical reasons, only element 1 is used!
integer(pInt), dimension(2), protected, public :: &
numerics_integrator = 1_pInt !< method used for state integration (central & perturbed state), Default 1: fix-point iteration for both states
real(pReal), protected, public :: &
@ -95,7 +93,7 @@ module numerics
! spectral parameters:
#ifdef Spectral
real(pReal), protected, public :: &
err_div_tolAbs = 1.0e-10_pReal, & !< absolute tolerance for equilibrium
err_div_tolAbs = 1.0e-4_pReal, & !< absolute tolerance for equilibrium
err_div_tolRel = 5.0e-4_pReal, & !< relative tolerance for equilibrium
err_curl_tolAbs = 1.0e-10_pReal, & !< absolute tolerance for compatibility
err_curl_tolRel = 5.0e-4_pReal, & !< relative tolerance for compatibility
@ -284,8 +282,6 @@ subroutine numerics_init
pert_Fg = IO_floatValue(line,chunkPos,2_pInt)
case ('pert_method')
pert_method = IO_intValue(line,chunkPos,2_pInt)
case ('nhomog')
nHomog = IO_intValue(line,chunkPos,2_pInt)
case ('nmpstate')
nMPstate = IO_intValue(line,chunkPos,2_pInt)
case ('ncryst')
@ -317,9 +313,7 @@ subroutine numerics_init
case ('atol_crystallitestress')
aTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt)
case ('integrator')
numerics_integrator(1) = IO_intValue(line,chunkPos,2_pInt)
case ('integratorstiffness')
numerics_integrator(2) = IO_intValue(line,chunkPos,2_pInt)
numerics_integrator = IO_intValue(line,chunkPos,2_pInt)
case ('usepingpong')
usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
case ('timesyncing')
@ -536,7 +530,6 @@ subroutine numerics_init
write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong
write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength
write(6,'(a24,1x,i8)') ' nHomog: ',nHomog
write(6,'(a24,1x,es8.1)') ' subStepMinHomog: ',subStepMinHomog
write(6,'(a24,1x,es8.1)') ' subStepSizeHomog: ',subStepSizeHomog
write(6,'(a24,1x,es8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog
@ -646,7 +639,6 @@ subroutine numerics_init
if (pert_Fg <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pert_Fg')
if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) &
call IO_error(301_pInt,ext_msg='pert_method')
if (nHomog < 1_pInt) call IO_error(301_pInt,ext_msg='nHomog')
if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate')
if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst')
if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState')

3
src/plastic_isotropic.f90
View File

@ -109,11 +109,9 @@ use IO
type(tParameters), pointer :: prm
integer(pInt) :: &
o, &
phase, &
instance, &
maxNinstance, &
mySize, &
sizeDotState, &
sizeState, &
sizeDeltaState
@ -136,7 +134,6 @@ use IO
plastic_isotropic_output = ''
allocate(plastic_isotropic_Noutput(maxNinstance), source=0_pInt)
! inernal variable
allocate(param(maxNinstance)) ! one container of parameters per instance
allocate(state(maxNinstance)) ! internal state aliases
allocate(dotState(maxNinstance))

50
src/plastic_none.f90
View File

@ -4,16 +4,9 @@
!> @brief material subroutine for purely elastic material
!--------------------------------------------------------------------------------------------------
module plastic_none
use prec, only: &
pInt
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
plastic_none_sizePostResults
integer(pInt), dimension(:,:), allocatable, target, public :: &
plastic_none_sizePostResult !< size of each post result output
public :: &
plastic_none_init
@ -31,6 +24,8 @@ subroutine plastic_none_init
compiler_version, &
compiler_options
#endif
use prec, only: &
pInt
use debug, only: &
debug_level, &
debug_constitutive, &
@ -51,18 +46,13 @@ subroutine plastic_none_init
integer(pInt) :: &
maxNinstance, &
phase, &
NofMyPhase, &
sizeState, &
sizeDotState, &
sizeDeltaState
NofMyPhase
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_plasticity == PLASTICITY_none_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
@ -70,37 +60,25 @@ subroutine plastic_none_init
if (phase_plasticity(phase) == PLASTICITY_none_ID) then
NofMyPhase=count(material_phase==phase)
sizeState = 0_pInt
plasticState(phase)%sizeState = sizeState
sizeDotState = sizeState
plasticState(phase)%sizeDotState = sizeDotState
sizeDeltaState = 0_pInt
plasticState(phase)%sizeDeltaState = sizeDeltaState
plasticState(phase)%sizePostResults = 0_pInt
plasticState(phase)%nSlip = 0_pInt
plasticState(phase)%nTwin = 0_pInt
plasticState(phase)%nTrans = 0_pInt
allocate(plasticState(phase)%aTolState (sizeState))
allocate(plasticState(phase)%state0 (sizeState,NofMyPhase))
allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase))
allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase))
allocate(plasticState(phase)%state (sizeState,NofMyPhase))
allocate(plasticState(phase)%aTolState (0_pInt))
allocate(plasticState(phase)%state0 (0_pInt,NofMyPhase))
allocate(plasticState(phase)%partionedState0 (0_pInt,NofMyPhase))
allocate(plasticState(phase)%subState0 (0_pInt,NofMyPhase))
allocate(plasticState(phase)%state (0_pInt,NofMyPhase))
allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase))
allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase))
allocate(plasticState(phase)%dotState (0_pInt,NofMyPhase))
allocate(plasticState(phase)%deltaState (0_pInt,NofMyPhase))
if (any(numerics_integrator == 1_pInt)) then
allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase))
allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase))
allocate(plasticState(phase)%previousDotState (0_pInt,NofMyPhase))
allocate(plasticState(phase)%previousDotState2(0_pInt,NofMyPhase))
endif
if (any(numerics_integrator == 4_pInt)) &
allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase))
allocate(plasticState(phase)%RK4dotState (0_pInt,NofMyPhase))
if (any(numerics_integrator == 5_pInt)) &
allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase))
allocate(plasticState(phase)%RKCK45dotState (6,0_pInt,NofMyPhase))
endif
enddo initializeInstances
allocate(plastic_none_sizePostResults(maxNinstance), source=0_pInt)
end subroutine plastic_none_init
end module plastic_none

5
src/plastic_nonlocal.f90
View File

@ -2382,8 +2382,7 @@ use, intrinsic :: &
use prec, only: dNeq0, &
dNeq, &
dEq0
use numerics, only: numerics_integrationMode, &
numerics_timeSyncing
use numerics, only: numerics_timeSyncing
use IO, only: IO_error
use debug, only: debug_level, &
debug_constitutive, &
@ -2942,14 +2941,12 @@ rhoDot = rhoDotFlux &
+ rhoDotAthermalAnnihilation &
+ rhoDotThermalAnnihilation
if (numerics_integrationMode == 1_pInt) then ! save rates for output if in central integration mode
rhoDotFluxOutput(1:ns,1:8,1_pInt,ip,el) = rhoDotFlux(1:ns,1:8)
rhoDotMultiplicationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotMultiplication(1:ns,[1,3])
rhoDotSingle2DipoleGlideOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10)
rhoDotAthermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotAthermalAnnihilation(1:ns,9:10)
rhoDotThermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotThermalAnnihilation(1:ns,9:10)
rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1)
endif
#ifdef DEBUG

1264
src/plastic_phenopowerlaw.f90
View File

File diff suppressed because it is too large Load Diff

14
src/prec.f90
View File

@ -7,6 +7,7 @@
!> @brief setting precision for real and int type
!--------------------------------------------------------------------------------------------------
module prec
! ToDo: use, intrinsic :: iso_fortran_env, only : I8 => int64, WP => real64
implicit none
private
#if (FLOAT==8)
@ -23,26 +24,27 @@ module prec
NO SUITABLE PRECISION FOR INTEGER SELECTED, STOPPING COMPILATION
#endif
integer, parameter, public :: pStringLen = 256 !< default string lenth
integer, parameter, public :: pLongInt = 8 !< integer representation 64 bit (was selected_int_kind(12), number with at least up to +- 1e12)
real(pReal), parameter, public :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation)
integer(pInt), allocatable, dimension(:) :: realloc_lhs_test
type, public :: p_vec !< variable length datatype used for storage of state
type, public :: group_float !< variable length datatype used for storage of state
real(pReal), dimension(:), pointer :: p
end type p_vec
end type group_float
type, public :: p_intvec
type, public :: group_int
integer(pInt), dimension(:), pointer :: p
end type p_intvec
end type group_int
!http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array
type, public :: tState
integer(pInt) :: &
sizeState = 0_pInt, & !< size of state
sizeDotState = 0_pInt, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates
offsetDeltaState = 0_pInt, & !< offset of delta state
sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDot) follows time evolution by deltaState increments
offsetDeltaState = 0_pInt, & !< index offset of delta state
sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments
sizePostResults = 0_pInt !< size of output data
real(pReal), pointer, dimension(:), contiguous :: &
atolState

2
src/spectral_thermal.f90
View File

@ -65,8 +65,6 @@ subroutine spectral_thermal_init
compiler_options
#endif
use IO, only: &
IO_intOut, &
IO_read_realFile, &
IO_timeStamp
use spectral_utilities, only: &
wgt

44
src/system_routines.f90
View File

@ -78,28 +78,30 @@ end function isDirectory
!--------------------------------------------------------------------------------------------------
!> @brief gets the current working directory
!--------------------------------------------------------------------------------------------------
logical function getCWD(str)
character(len=1024) function getCWD()
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(len=*), intent(out) :: str
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
str = repeat('',len(str))
call getCurrentWorkDir_C(strFixedLength,stat)
do i=1,1024 ! copy array components until Null string is found
if (strFixedLength(i) /= C_NULL_CHAR) then
str(i:i)=strFixedLength(i)
call getCurrentWorkDir_C(charArray,stat)
if (stat /= 0_C_INT) then
getCWD = 'Error occured when getting currend working directory'
else
getCWD = repeat('',len(getCWD))
arrayToString: do i=1,len(getCWD)
if (charArray(i) /= C_NULL_CHAR) then
getCWD(i:i)=charArray(i)
else
exit
endif
enddo
getCWD=merge(.True.,.False.,stat /= 0_C_INT)
enddo arrayToString
endif
end function getCWD
@ -107,28 +109,30 @@ end function getCWD
!--------------------------------------------------------------------------------------------------
!> @brief gets the current host name
!--------------------------------------------------------------------------------------------------
logical function getHostName(str)
character(len=1024) function getHostName()
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(len=*), intent(out) :: str
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
str = repeat('',len(str))
call getHostName_C(strFixedLength,stat)
do i=1,1024 ! copy array components until Null string is found
if (strFixedLength(i) /= C_NULL_CHAR) then
str(i:i)=strFixedLength(i)
call getHostName_C(charArray,stat)
if (stat /= 0_C_INT) then
getHostName = 'Error occured when getting host name'
else
getHostName = repeat('',len(getHostName))
arrayToString: do i=1,len(getHostName)
if (charArray(i) /= C_NULL_CHAR) then
getHostName(i:i)=charArray(i)
else
exit
endif
enddo
getHostName=merge(.True.,.False.,stat /= 0_C_INT)
enddo arrayToString
endif
end function getHostName

4
src/vacancyflux_cahnhilliard.f90
View File

@ -7,7 +7,7 @@ module vacancyflux_cahnhilliard
use prec, only: &
pReal, &
pInt, &
p_vec
group_float
implicit none
private
@ -26,7 +26,7 @@ module vacancyflux_cahnhilliard
real(pReal), dimension(:), allocatable, private :: &
vacancyflux_cahnhilliard_flucAmplitude
type(p_vec), dimension(:), allocatable, private :: &
type(group_float), dimension(:), allocatable, private :: &
vacancyflux_cahnhilliard_thermalFluc
real(pReal), parameter, private :: &