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

Merge remote-tracking branch 'origin/development' into 231-no-petscscalar-and-_range

This commit is contained in:
Martin Diehl 2022-12-10 14:46:56 +01:00
parent e8aeb4435d 353d55c9a7
commit e6c2e73e03
73 changed files with 4247 additions and 1233 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -14,7 +14,7 @@
# ignore files from MSC.Marc in language statistics # ignore files from MSC.Marc in language statistics
install/MarcMentat/** linguist-vendored install/MarcMentat/** linguist-vendored
src/Marc/include/* linguist-vendored src/Marc/include/* linguist-vendored
install/MarcMentat/apply_DAMASK_modifications.py linguist-vendored=false install/MarcMentat/MSC_modifications.py linguist-vendored=false
# ignore reference files for tests in language statistics # ignore reference files for tests in language statistics
python/tests/reference/** linguist-vendored python/tests/reference/** linguist-vendored

2
.gitlab-ci.yml
View File

@ -47,7 +47,7 @@ variables:
PETSC_INTELLLVM: "Libraries/PETSc/3.16.3/oneAPI-2022.0.1-IntelMPI-2021.5.0" PETSC_INTELLLVM: "Libraries/PETSc/3.16.3/oneAPI-2022.0.1-IntelMPI-2021.5.0"
PETSC_INTEL: "Libraries/PETSc/3.16.5/Intel-2022.0.1-IntelMPI-2021.5.0" PETSC_INTEL: "Libraries/PETSc/3.16.5/Intel-2022.0.1-IntelMPI-2021.5.0"
# ++++++++++++ MSC Marc +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ MSC Marc +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
MSC: "FEM/MSC/2022.2" MSC: "FEM/MSC/2022.3"
IntelMarc: "Compiler/Intel/19.1.2 Libraries/IMKL/2020" IntelMarc: "Compiler/Intel/19.1.2 Libraries/IMKL/2020"
HDF5Marc: "HDF5/1.12.2/Intel-19.1.2" HDF5Marc: "HDF5/1.12.2/Intel-19.1.2"

2
PRIVATE

@ -1 +1 @@
Subproject commit ecfe3b3f057f4f81b3b1a12399bf238bc2546de7 Subproject commit e9254133c1e9ea3855a4fd17078d4c6f7d8728b1

2
VERSION
View File

@ -1 +1 @@
3.0.0-alpha7-171-g26ff1b895 3.0.0-alpha7-220-g85115d12f

4
examples/config/phase/thermal/source/externalheat_ramp-and-hold.yaml
View File

@ -1,4 +1,4 @@
type: externalheat type: externalheat
f_T: [1, 1, 0, 0] f: [1, 1, 0, 0]
t_n: [0, 500, 500.001, 1000] t: [0, 500, 500.001, 1000]

49
install/MarcMentat/2022.3/Marc_tools/comp_damask_hmp.patch vendored Normal file
View File

@ -0,0 +1,49 @@
---
+++
@@ -6,18 +6,27 @@
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.f on host `hostname`"
+echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
- $FORTRAN $user.f || \
+ $DFORTHIGHMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
- userobj=$user.o
+ userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
@@ -33,9 +42,13 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $BLAS \
$SYSLIBS || \
{
- echo "$0: link failed for $user.o on host `hostname`"
+ echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
+ /bin/rm $DIRJOB/*.mod
+ /bin/rm $DIRJOB/*.smod
+ /bin/rm $DIRJOB/*_genmod.f90

49
install/MarcMentat/2022.3/Marc_tools/comp_damask_lmp.patch vendored Normal file
View File

@ -0,0 +1,49 @@
---
+++
@@ -6,18 +6,27 @@
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.f on host `hostname`"
+echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
- $FORTRAN $user.f || \
+ $DFORTRANLOWMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
- userobj=$user.o
+ userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
@@ -33,9 +42,13 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $BLAS \
$SYSLIBS || \
{
- echo "$0: link failed for $user.o on host `hostname`"
+ echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
+ /bin/rm $DIRJOB/*.mod
+ /bin/rm $DIRJOB/*.smod
+ /bin/rm $DIRJOB/*_genmod.f90

49
install/MarcMentat/2022.3/Marc_tools/comp_damask_mp.patch vendored Normal file
View File

@ -0,0 +1,49 @@
---
+++
@@ -6,18 +6,27 @@
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.f on host `hostname`"
+echo "Compiling and linking user subroutine $user on host `hostname`"
echo "program: $program"
- $FORTRAN $user.f || \
+ $DFORTRANMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
- userobj=$user.o
+ userobj=$usernoext.o
$LOAD ${program} $DIR/lib/main.o\
@@ -33,9 +42,13 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $BLAS \
$SYSLIBS || \
{
- echo "$0: link failed for $user.o on host `hostname`"
+ echo "$0: link failed for $usernoext.o on host `hostname`"
exit 1
}
/bin/rm $userobj
+ /bin/rm $DIRJOB/*.mod
+ /bin/rm $DIRJOB/*.smod
+ /bin/rm $DIRJOB/*_genmod.f90

75
install/MarcMentat/2022.3/Marc_tools/include_linux64.patch vendored Normal file
View File

@ -0,0 +1,75 @@
---
+++
@@ -166,6 +166,15 @@
MARC_COSIM_LIB="$MSCCOSIM_HOME/CoSim$MSCCOSIM_VERSION/Dcosim$MSCCOSIM_VERSION/lib"
fi
+# DAMASK uses the HDF5 compiler wrapper around the Intel compiler
+H5FC=$(h5fc -shlib -show)
+if [[ "$H5FC" == *"$dir is"* ]]; then
+ H5FC=$(echo $(echo "$H5FC" | tail -n1) | sed -e "s/\-shlib/-fPIC -qopenmp/g")
+ H5FC=${H5FC%-lmpifort*}
+fi
+HDF5_LIB=${H5FC//*ifort/}
+FCOMP="$H5FC"
+
# AEM
if test "$MARCDLLOUTDIR" = ""; then
DLLOUTDIR="$MARC_LIB"
@@ -594,7 +603,7 @@
PROFILE=" $PROFILE -pg"
fi
-FORT_OPT="-c -assume byterecl -safe_cray_ptr -mp1 -WB -fp-model source"
+FORT_OPT="-c -implicitnone -stand f18 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr -mp1 -WB -fp-model source"
if test "$MTHREAD" = "OPENMP"
then
FORT_OPT=" $FORT_OPT -qopenmp"
@@ -607,7 +616,7 @@
FORT_OPT=" $FORT_OPT -save -zero"
fi
if test "$MARCHDF_HDF" = "HDF"; then
- FORT_OPT="$FORT_OPT -DMARCHDF_HDF=$MARCHDF_HDF $HDF_INCLUDE"
+ FORT_OPT="$FORT_OPT -DMARCHDF=$MARCHDF_HDF"
fi
FORTLOW="$FCOMP $FORT_OPT $PROFILE -O0 $I8FFLAGS -I$MARC_SOURCE/common \
@@ -621,6 +630,29 @@
# for compiling free form f90 files. high opt, integer(4)
FORTF90="$FCOMP -c -O3"
+# determine DAMASK version
+if test -n "$DAMASK_USER"; then
+ DAMASKROOT=`dirname $DAMASK_USER`/../..
+ read DAMASKVERSION < $DAMASKROOT/VERSION
+ DAMASKVERSION="'"$DAMASKVERSION"'"
+else
+ DAMASKVERSION="'N/A'"
+fi
+
+# DAMASK compiler calls
+DFORTLOWMP="$FCOMP -c -O0 -qno-offload -implicitnone -stand f18 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
+ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMARC4DAMASK=2022.1 -DDAMASKVERSION=$DAMASKVERSION \
+ -qopenmp -qopenmp-threadprivate=compat\
+ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD -I$MARC_MOD"
+DFORTRANMP="$FCOMP -c -O1 -qno-offload -implicitnone -stand f18 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
+ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMARC4DAMASK=2022.1 -DDAMASKVERSION=$DAMASKVERSION \
+ -qopenmp -qopenmp-threadprivate=compat\
+ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD -I$MARC_MOD"
+DFORTHIGHMP="$FCOMP -c -O3 -qno-offload -implicitnone -stand f18 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
+ -fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMARC4DAMASK=2022.1 -DDAMASKVERSION=$DAMASKVERSION \
+ -qopenmp -qopenmp-threadprivate=compat\
+ $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD -I$MARC_MOD"
+
if test "$MARCDEBUG" = "ON"
then
FORTLOW="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
@@ -778,7 +810,7 @@
SOLVERLIBS="${BCSSOLVERLIBS} ${VKISOLVERLIBS} ${CASISOLVERLIBS} ${MF2SOLVERLIBS} \
-L$MARC_MKL \
- $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/libkdtree2.a $MARC_LIB/libtetmeshinterface.a $MARC_LIB/libcaefatigueinterface.a -L$MARC_LIB -lmkl_blacs_intelmpi_ilp64 -lmkl_scalapack_ilp64 -lmkl_intel_ilp64 -lmkl_intel_thread -lmkl_core -liomp5 -ltetmesh -lmeshgems -lmg-tetra -lmeshgems_stubs $HDF_LIBS $SOLVER2LIBS"
+ $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/libkdtree2.a $MARC_LIB/libtetmeshinterface.a $MARC_LIB/libcaefatigueinterface.a -L$MARC_LIB -lmkl_blacs_intelmpi_ilp64 -lmkl_scalapack_ilp64 -lmkl_intel_ilp64 -lmkl_intel_thread -lmkl_core -liomp5 -ltetmesh -lmeshgems -lmg-tetra -lmeshgems_stubs $HDF5_LIB $SOLVER2LIBS"
SOLVERLIBS_DLL=${SOLVERLIBS}
if test "$AEM_DLL" -eq 1

517
install/MarcMentat/2022.3/Marc_tools/run_damask_hmp.patch vendored Normal file
View File

@ -0,0 +1,517 @@
---
+++
@@ -136,6 +136,11 @@
# is created. For job running in the background, the log #
# file is always created. Default is "yes" #
##############################################################################
+# remove all Mentat paths from LD_LIBRARY_PATH
+LD_LIBRARY_PATH=:$LD_LIBRARY_PATH:
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([!(:)])mentat2022.2+([!(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH#:}; LD_LIBRARY_PATH=${LD_LIBRARY_PATH%:}
# set DIR to the directory in which this script is
REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`"
DIR=`dirname $REALCOM`
@@ -302,7 +307,23 @@
. "$DIR/getarch"
+
+# getting user subroutine file name
+found=0
+for i in "$@"; do
+ if test $found = 1; then
+ DAMASK_USER=$i
+ found=0
+ fi
+ case $i in
+ -u* | -U*)
+ found=1
+ ;;
+ esac
+done
+# sourcing include_linux64 (needs DAMASK_USER to be set)
. $MARC_INCLUDE
+
#
#
@@ -405,7 +426,7 @@
did=
vid=
user=
-usersubname=
+usernoext=
objs=
qid=background
cpu=
@@ -676,50 +697,19 @@
esac
;;
-u* | -U*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ 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`
;;
-obj | -OBJ)
objs="$value"
@@ -1207,12 +1197,12 @@
fi
fi
fi
- if test "$usersubname"
+ if test "$user"
then
- if test ! -f $usersubname
+ if test ! -f $user
then
error="$error
-user subroutine file $usersubname not accessible"
+user subroutine file $user not accessible"
fi
fi
if test "$objs"
@@ -1531,7 +1521,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1564,7 +1554,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1687,7 +1677,7 @@
;;
esac
fi
- $ECHO "User subroutine name ($usersubname)? $ECHOTXT"
+ $ECHO "User subroutine name ($user)? $ECHOTXT"
read value
if test "$value"
then
@@ -1696,50 +1686,19 @@
user=
;;
*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ 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`
;;
esac
fi
@@ -2274,11 +2233,12 @@
#
# user subroutine used
#
+# add DAMASK options for linking
+ DAMASK="-lstdc++"
if test "$user"
then
-# program=$user.marc
- program=$DIRJOB/`$BASENAME $user .f`.marc
+ program=$usernoext.marc
case $program in
\/* | \.\/*)
bd=
@@ -2391,7 +2351,7 @@
fi
if test "$user"
then
- execpath=$DIRJOB/`$BASENAME $user .f`.marc
+ execpath=$usernoext.marc
usersub=1
fi
export execpath
@@ -3274,44 +3234,27 @@
echo
if test "$user"
then
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
- fi
-
+ userobj=$usernoext.o
fi
cat > $jid.runmarcscript << END4
if test "$user"
then
- if test ${basefile##*.} = f
- then
- ln -sf "$user.f" "$usersub"
- fi
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTHIGHMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTHIGHMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi
@@ -3331,6 +3274,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3344,6 +3288,9 @@
prgsav=yes
fi
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3390,7 +3337,7 @@
fi
else
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes
@@ -3556,7 +3503,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3569,21 +3516,21 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_hmp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
echo " $PRODUCT Exit number 3"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3593,39 +3540,27 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTHIGHMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTHIGHMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3645,6 +3580,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3686,6 +3622,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3779,7 +3718,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then
@@ -3904,7 +3843,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3917,20 +3856,20 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_hmp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3940,37 +3879,25 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTHIGHMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTHIGHMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3990,6 +3917,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -4030,7 +3958,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
-
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
# done if no job id given
if test -z "$jid"
then
@@ -4149,7 +4079,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then

517
install/MarcMentat/2022.3/Marc_tools/run_damask_lmp.patch vendored Normal file
View File

@ -0,0 +1,517 @@
---
+++
@@ -136,6 +136,11 @@
# is created. For job running in the background, the log #
# file is always created. Default is "yes" #
##############################################################################
+# remove all Mentat paths from LD_LIBRARY_PATH
+LD_LIBRARY_PATH=:$LD_LIBRARY_PATH:
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([!(:)])mentat2022.2+([!(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH#:}; LD_LIBRARY_PATH=${LD_LIBRARY_PATH%:}
# set DIR to the directory in which this script is
REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`"
DIR=`dirname $REALCOM`
@@ -302,7 +307,23 @@
. "$DIR/getarch"
+
+# getting user subroutine file name
+found=0
+for i in "$@"; do
+ if test $found = 1; then
+ DAMASK_USER=$i
+ found=0
+ fi
+ case $i in
+ -u* | -U*)
+ found=1
+ ;;
+ esac
+done
+# sourcing include_linux64 (needs DAMASK_USER to be set)
. $MARC_INCLUDE
+
#
#
@@ -405,7 +426,7 @@
did=
vid=
user=
-usersubname=
+usernoext=
objs=
qid=background
cpu=
@@ -676,50 +697,19 @@
esac
;;
-u* | -U*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ 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`
;;
-obj | -OBJ)
objs="$value"
@@ -1207,12 +1197,12 @@
fi
fi
fi
- if test "$usersubname"
+ if test "$user"
then
- if test ! -f $usersubname
+ if test ! -f $user
then
error="$error
-user subroutine file $usersubname not accessible"
+user subroutine file $user not accessible"
fi
fi
if test "$objs"
@@ -1531,7 +1521,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1564,7 +1554,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1687,7 +1677,7 @@
;;
esac
fi
- $ECHO "User subroutine name ($usersubname)? $ECHOTXT"
+ $ECHO "User subroutine name ($user)? $ECHOTXT"
read value
if test "$value"
then
@@ -1696,50 +1686,19 @@
user=
;;
*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ 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`
;;
esac
fi
@@ -2274,11 +2233,12 @@
#
# user subroutine used
#
+# add DAMASK options for linking
+ DAMASK="-lstdc++"
if test "$user"
then
-# program=$user.marc
- program=$DIRJOB/`$BASENAME $user .f`.marc
+ program=$usernoext.marc
case $program in
\/* | \.\/*)
bd=
@@ -2391,7 +2351,7 @@
fi
if test "$user"
then
- execpath=$DIRJOB/`$BASENAME $user .f`.marc
+ execpath=$usernoext.marc
usersub=1
fi
export execpath
@@ -3274,44 +3234,27 @@
echo
if test "$user"
then
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
- fi
-
+ userobj=$usernoext.o
fi
cat > $jid.runmarcscript << END4
if test "$user"
then
- if test ${basefile##*.} = f
- then
- ln -sf "$user.f" "$usersub"
- fi
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTLOWMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTLOWMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi
@@ -3331,6 +3274,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3344,6 +3288,9 @@
prgsav=yes
fi
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3390,7 +3337,7 @@
fi
else
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes
@@ -3556,7 +3503,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3569,21 +3516,21 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_lmp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
echo " $PRODUCT Exit number 3"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3593,39 +3540,27 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTLOWMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTLOWMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3645,6 +3580,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3686,6 +3622,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3779,7 +3718,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then
@@ -3904,7 +3843,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3917,20 +3856,20 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_lmp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3940,37 +3879,25 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTLOWMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTLOWMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3990,6 +3917,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -4030,7 +3958,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
-
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
# done if no job id given
if test -z "$jid"
then
@@ -4149,7 +4079,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then

517
install/MarcMentat/2022.3/Marc_tools/run_damask_mp.patch vendored Normal file
View File

@ -0,0 +1,517 @@
---
+++
@@ -136,6 +136,11 @@
# is created. For job running in the background, the log #
# file is always created. Default is "yes" #
##############################################################################
+# remove all Mentat paths from LD_LIBRARY_PATH
+LD_LIBRARY_PATH=:$LD_LIBRARY_PATH:
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([!(:)])mentat2022.2+([!(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH//+([(:)])/:}
+LD_LIBRARY_PATH=${LD_LIBRARY_PATH#:}; LD_LIBRARY_PATH=${LD_LIBRARY_PATH%:}
# set DIR to the directory in which this script is
REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`"
DIR=`dirname $REALCOM`
@@ -302,7 +307,23 @@
. "$DIR/getarch"
+
+# getting user subroutine file name
+found=0
+for i in "$@"; do
+ if test $found = 1; then
+ DAMASK_USER=$i
+ found=0
+ fi
+ case $i in
+ -u* | -U*)
+ found=1
+ ;;
+ esac
+done
+# sourcing include_linux64 (needs DAMASK_USER to be set)
. $MARC_INCLUDE
+
#
#
@@ -405,7 +426,7 @@
did=
vid=
user=
-usersubname=
+usernoext=
objs=
qid=background
cpu=
@@ -676,50 +697,19 @@
esac
;;
-u* | -U*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ 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`
;;
-obj | -OBJ)
objs="$value"
@@ -1207,12 +1197,12 @@
fi
fi
fi
- if test "$usersubname"
+ if test "$user"
then
- if test ! -f $usersubname
+ if test ! -f $user
then
error="$error
-user subroutine file $usersubname not accessible"
+user subroutine file $user not accessible"
fi
fi
if test "$objs"
@@ -1531,7 +1521,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1564,7 +1554,7 @@
Marc shared lib : $progdll
Version type : $mode
Job ID : $DIRJID/$jid$extra_job_info
-User subroutine name : $usersubname
+User subroutine name : $user
User objects/libs : $objs
Restart file job ID : $rid
Substructure file ID : $sid
@@ -1687,7 +1677,7 @@
;;
esac
fi
- $ECHO "User subroutine name ($usersubname)? $ECHOTXT"
+ $ECHO "User subroutine name ($user)? $ECHOTXT"
read value
if test "$value"
then
@@ -1696,50 +1686,19 @@
user=
;;
*)
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user
- basefile=`$BASENAME $value`
- if test ${basefile##*.} = f
- then
- user=`dirname $value`/`$BASENAME $value .f`
- usersubname=$user.f
- elif test ${basefile##*.} = F
- then
- user=`dirname $value`/`$BASENAME $value .F`
- usersubname=$user.F
- elif test ${basefile##*.} = f90
- then
- user=`dirname $value`/`$BASENAME $value .f90`
- usersubname=$user.f90
- elif test ${basefile##*.} = F90
- then
- user=`dirname $value`/`$BASENAME $value .F90`
- usersubname=$user.F90
- fi
+ user=$value
case $user in
\/*)
;;
*)
user=`pwd`/$user
- usersubname=`pwd`/$usersubname
;;
esac
- if test ! -f $usersubname
- then
- if test -f $usersubname.f
- then
- usersubname=$usersubname.f
- elif test -f $usersubname.F
- then
- usersubname=$usersubname.F
- elif test -f $usersubname.f90
- then
- usersubname=$usersubname.f90
- elif test -f $usersubname.F90
- then
- usersubname=$usersubname.F90
- fi
- fi
+ 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`
;;
esac
fi
@@ -2274,11 +2233,12 @@
#
# user subroutine used
#
+# add DAMASK options for linking
+ DAMASK="-lstdc++"
if test "$user"
then
-# program=$user.marc
- program=$DIRJOB/`$BASENAME $user .f`.marc
+ program=$usernoext.marc
case $program in
\/* | \.\/*)
bd=
@@ -2391,7 +2351,7 @@
fi
if test "$user"
then
- execpath=$DIRJOB/`$BASENAME $user .f`.marc
+ execpath=$usernoext.marc
usersub=1
fi
export execpath
@@ -3274,44 +3234,27 @@
echo
if test "$user"
then
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
- fi
-
+ userobj=$usernoext.o
fi
cat > $jid.runmarcscript << END4
if test "$user"
then
- if test ${basefile##*.} = f
- then
- ln -sf "$user.f" "$usersub"
- fi
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTRANMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTRANMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi
@@ -3331,6 +3274,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3344,6 +3288,9 @@
prgsav=yes
fi
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3390,7 +3337,7 @@
fi
else
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes
@@ -3556,7 +3503,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3569,21 +3516,21 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_mp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
echo " $PRODUCT Exit number 3"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3593,39 +3540,27 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTRANMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTRANMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
echo " $PRODUCT Exit number 3"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3645,6 +3580,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -3686,6 +3622,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
#
# run marc
@@ -3779,7 +3718,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then
@@ -3904,7 +3843,7 @@
# first copy over the user sub if local directories
if test ${dirstatus[$counter]} = "local"
then
- $RCP $user.f $i:$DIR1/
+ $RCP $user $i:$DIR1/
fi
# do the compilation on the other machine
if test ${dirstatus[$counter]} = "shared"
@@ -3917,20 +3856,20 @@
remoteuser=$DIR1/`$BASENAME $user`
$RSH $i /bin/rm $remoteprog 2> /dev/null
echo
- $RSH $i $DIR2/tools/comp_user $DIR2 $DIR1 $remoteuser $remoteprog
+ $RSH $i $DIR2/tools/comp_damask_mp $DIR2 $DIR1 $remoteuser $remoteprog
# check if successful, the new executable should be there
line=`$RSH $i /bin/ls $remoteprog 2> /dev/null`
if test "$line"
then
echo compilation and linking successful on host $i
else
- echo "$0: compile failed for $user.f on host $i"
+ echo "$0: compile failed for $user on host $i"
exit 1
fi
# remove the user subroutine on remote machine
if test ${dirstatus[$counter]} = "local"
then
- $RSH $i /bin/rm $remoteuser.f 2> /dev/null
+ $RSH $i /bin/rm $remoteuser 2> /dev/null
fi
fi
fi
@@ -3940,37 +3879,25 @@
if test "$userhost"
then
echo
- echo "Compiling and linking user subroutine $user.f on host `hostname`"
- fi
- userobj=$DIRJOB/`$BASENAME $user .f`.o
- basefile=`$BASENAME $usersubname`
- if test ${basefile##*.} = f
- then
- usersub=$DIRJOB/`$BASENAME $user .f`.F
- ln -sf "$user.f" "$usersub"
- else
- usersub=$usersubname
+ echo "Compiling and linking user subroutine $user on host `hostname`"
fi
+ userobj=$usernoext.o
if test $MACHINENAME = "CRAY"
then
- $FORTRAN $usersub || \
+ $DFORTRANMP $user || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
else
- $FORTRAN $usersub -o $userobj || \
+ $DFORTRANMP $user -o $userobj || \
{
- echo "$0: compile failed for $user.f"
+ echo "$0: compile failed for $user"
exit 1
}
/bin/rm $program 2>/dev/null
fi
- if test ${basefile##*.} = f
- then
- /bin/rm -f "$usersub"
- fi
fi # if test $user
@@ -3990,6 +3917,7 @@
$TKLIBS \
$MRCLIBS \
$METISLIBS \
+ $DAMASK \
$SFLIB \
$OPENSSL_LIB \
$SYSLIBS \
@@ -4030,7 +3958,9 @@
prgsav=yes
fi # if test $link
/bin/rm $userobj 2>/dev/null
-
+/bin/rm $DIRJOB/*.mod 2>/dev/null
+/bin/rm $DIRJOB/*.smod 2>/dev/null
+/bin/rm $DIRJOB/*_genmod.f90 2>/dev/null
# done if no job id given
if test -z "$jid"
then
@@ -4149,7 +4079,7 @@
else
#dllrun >0
if test $cpdll = yes; then
- filename=`basename $usersubname .f`
+ filename=$usernoext
/bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null
fi
if test $rmdll = yes;then

24
install/MarcMentat/2022.3/Mentat_bin/edit_window.patch vendored Normal file
View File

@ -0,0 +1,24 @@
---
+++
@@ -1,18 +1,5 @@
#!/bin/sh
-# This script opens a window running an editor. The default window is an
-# xterm, and the default editor is vi. These may be customized.
+# This script opens a window running an editor.
+# The command to invoke the editor is specified during DAMASK installation
-dir=
-for d in /usr/bin /usr/bin/X11; do
- if test -x "$d/xterm"; then
- dir="$d"
- break
- fi
-done
-
-if test -z "$dir"; then
- echo "$0: Could not find xterm"
- exit 1
-fi
-
-"$dir/xterm" -T "vi $*" -n "vi $*" -e vi $*
+%EDITOR% $*

0
install/MarcMentat/2022.3/Mentat_bin/kill4.patch vendored Normal file
View File

0
install/MarcMentat/2022.3/Mentat_bin/kill5.patch vendored Normal file
View File

0
install/MarcMentat/2022.3/Mentat_bin/kill6.patch vendored Normal file
View File

38
install/MarcMentat/2022.3/Mentat_bin/submit4.patch vendored Normal file
View File

@ -0,0 +1,38 @@
---
+++
@@ -63,10 +63,10 @@
if [ "$slv" != "" -a "$slv" != "marc" -a "$slv" != "datfit" ]; then
slv="-iam sfm"
fi
-if [ "$slv" == "marc" ]; then
+if [ "$slv" = "marc" ]; then
slv=""
fi
-if [ "$slv" == "datfit" ]; then
+if [ "$slv" = "datfit" ]; then
slv="-iam datfit"
fi
@@ -91,6 +91,7 @@
srcfile="-u $srcfile -save y"
;;
runsaved)
+ srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
@@ -189,12 +190,12 @@
unset PYTHONPATH
if [ "$doe_first" = "-" ]; then # submit of regular Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b y $nprocds $nprocd \
+ "${DIR}/tools/run_damask_hmp" $slv -j $job -v n -b y $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
else # submit of a DoE Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b n $nprocds $nprocd \
+ "${DIR}/tools/run_damask_hmp" $slv -j $job -v n -b n $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu

38
install/MarcMentat/2022.3/Mentat_bin/submit5.patch vendored Normal file
View File

@ -0,0 +1,38 @@
---
+++
@@ -63,10 +63,10 @@
if [ "$slv" != "" -a "$slv" != "marc" -a "$slv" != "datfit" ]; then
slv="-iam sfm"
fi
-if [ "$slv" == "marc" ]; then
+if [ "$slv" = "marc" ]; then
slv=""
fi
-if [ "$slv" == "datfit" ]; then
+if [ "$slv" = "datfit" ]; then
slv="-iam datfit"
fi
@@ -91,6 +91,7 @@
srcfile="-u $srcfile -save y"
;;
runsaved)
+ srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
@@ -189,12 +190,12 @@
unset PYTHONPATH
if [ "$doe_first" = "-" ]; then # submit of regular Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b y $nprocds $nprocd \
+ "${DIR}/tools/run_damask_mp" $slv -j $job -v n -b y $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
else # submit of a DoE Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b n $nprocds $nprocd \
+ "${DIR}/tools/run_damask_mp" $slv -j $job -v n -b n $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu

38
install/MarcMentat/2022.3/Mentat_bin/submit6.patch vendored Normal file
View File

@ -0,0 +1,38 @@
---
+++
@@ -63,10 +63,10 @@
if [ "$slv" != "" -a "$slv" != "marc" -a "$slv" != "datfit" ]; then
slv="-iam sfm"
fi
-if [ "$slv" == "marc" ]; then
+if [ "$slv" = "marc" ]; then
slv=""
fi
-if [ "$slv" == "datfit" ]; then
+if [ "$slv" = "datfit" ]; then
slv="-iam datfit"
fi
@@ -91,6 +91,7 @@
srcfile="-u $srcfile -save y"
;;
runsaved)
+ srcfile=${srcfile%.*}".marc"
srcfile="-prog $srcfile"
;;
esac
@@ -189,12 +190,12 @@
unset PYTHONPATH
if [ "$doe_first" = "-" ]; then # submit of regular Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b y $nprocds $nprocd \
+ "${DIR}/tools/run_damask_lmp" $slv -j $job -v n -b y $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1
else # submit of a DoE Marc job
- "${DIR}/tools/run_marc" $slv -j $job -v n -b n $nprocds $nprocd \
+ "${DIR}/tools/run_damask_lmp" $slv -j $job -v n -b n $nprocds $nprocd \
$srcfile $restart $postfile $viewfactorsfile $hostfile \
$compat $copy_datfile $copy_postfile $scr_dir $dcoup \
$assem_recov_nthread $nthread $nsolver $mode $gpu

158
install/MarcMentat/2022.3/Mentat_menus/job_run.ms.patch vendored Normal file
View File

@ -0,0 +1,158 @@
---
+++
@@ -261,11 +261,18 @@
}
button {
position +25 =
- size 25 4
+ size 18 4
text "ADVANCED JOB SUBMISSION"
help "job_run#Job Submission And Control"
popmenu job_submit_adv_pm
}
+ button {
+ position +18 =
+ size 7 4
+ text "DAMASK"
+ help "damask_run#Job Submission And Control"
+ popmenu damask
+ }
button {
position 0 +4
size 16 4
@@ -1207,6 +1214,135 @@
}
+#--------------------------------------------------------------------------------------------------
+popmenu damask {
+
+#ifdef QT_MENTAT
+ text "DAMASK.MPIE.DE"
+#endif
+
+ group {
+#ifndef QT_MENTAT
+ label {
+ position 0 0
+ size 50 4
+ text "DAMASK.MPIE.DE"
+ }
+#endif
+
+ label {
+ position 1 6
+ size 13 6
+ text "Optimzation"
+ border_width 1
+ border_color black
+ }
+
+ label {
+ position +13 =
+ size 20 6
+ text "write Input"
+ border_width 1
+ border_color black
+ }
+
+ label {
+ position +18 =
+ size 30 6
+ text "do not write Inp."
+ border_width 1
+ border_color black
+ }
+
+ label {
+ position -32 +6
+ size 12 6
+ text "O3 / OpenMP"
+ border_width 1
+ border_color black
+ }
+
+ popdown {
+ position +12 =
+ size 20 6
+ text "Submit"
+ command "*submit_job 4 *monitor_job"
+ }
+
+ popdown {
+ position +20 =
+ size 20 6
+ text "Execute"
+ command "*execute_job 4 *monitor_job"
+ }
+
+ label {
+ position -32 +6
+ size 12 6
+ text "O1 / OpenMP"
+ border_width 1
+ border_color black
+ }
+
+ popdown {
+ position +12 =
+ size 20 6
+ text "Submit"
+ command "*submit_job 5 *monitor_job"
+ }
+
+ popdown {
+ position +20 =
+ size 20 6
+ text "Execute"
+ command "*execute_job 5 *monitor_job"
+ }
+
+ label {
+ position -32 +6
+ size 12 6
+ text "O0 / OpenMP"
+ border_width 1
+ border_color black
+ }
+
+ popdown {
+ position +12 =
+ size 20 6
+ text "Submit"
+ command "*submit_job 6 *monitor_job"
+ }
+
+ popdown {
+ position +20 =
+ size 20 6
+ text "Execute"
+ command "*execute_job 6 *monitor_job"
+ }
+
+ popdown {
+ position 19 +8
+ size 12 8
+ text "CANCEL"
+ }
+}
+
+ window {
+ parent mentat
+ origin 38 8
+#ifdef DCOM
+ size 50 100
+#else
+ size 50 94
+#endif
+ background_color body
+ border_width 1
+ border_color border
+ buffering single
+ }
+ mode permanent
+}
+
#--------------------------------------------------------------------------------------------------
popmenu job_exit_msg_pm {

262
processing/mentat_pbcOnBoxMesh.py Executable file
View File

@ -0,0 +1,262 @@
#!/usr/bin/env python3
import sys
import os
import re
import time
import tempfile
from optparse import OptionParser
import numpy as np
import damask
script_name = os.path.splitext(os.path.basename(__file__))[0]
script_id = ' '.join([script_name,damask.version])
# Convert .mfd file into a usable format
# Broken into labeled sections (eg. nodes, links, etc)
# Each section has a list of labeled elements with formatted numerical data
def parseMFD(dat):
formatted = []
section = 0
formatted.append({'label': 'header', 'uid': -1, 'els': []})
# in between =beg= and =end= part of file
in_block = False
for line in dat:
if in_block: # currently in a section
# lines that start with a space are numerical data
if line[0] == ' ':
formatted[section]['els'].append([])
# grab numbers
nums = re.split(r'\s+', line.strip())
for num in nums:
# floating point has format ' -x.xxxxxxxxxxxxe+yy'
# scientific notation is used for float
if (len(num) >= 4) and (num[-4] == 'e'):
formatted[section]['els'][-1].append(float(num))
else: # integer
formatted[section]['els'][-1].append(int(num))
else: # not numerical data, so it is a label for an element or section end
if line[0] == '=' and re.search(r'=end=$', line) is not None: # End of section, avoiding regex if possible
in_block = False
else:
formatted[section]['els'].append([])
formatted[section]['els'][-1] = line
else: # Not in a section, we are looking for a =beg= now
search = re.search(r'=beg=\s+(\d+)\s\((.*?)\)', line)
if search is not None: # found start of a new section
section += 1
in_block = True
formatted.append({'label': search.group(2), 'uid': int(search.group(1)), 'els': []})
else: # No =beg= found, probably in the header
# Either header or somthing we didn't plan for - just save the line so it isn't lost
if formatted[section]['uid'] > 0:
section += 1
formatted.append({'label': '', 'uid': -2, 'els': []}) # make dummy section to store unrecognized data
formatted[section]['els'].append(line)
return formatted
def asMFD(mfd_data):
result = ''
for section in mfd_data:
if section['uid'] > 0:
result += '=beg={0:5d} ({1})\n'.format(section['uid'], section['label'])
for el in section['els']:
if type(el) == str:
result += el
elif type(el) == list:
for num in el:
if type(num) == int:
result += '{:20d}'.format(num)
elif type(num) == float:
result += '{:20.12e}'.format(num)
else:
print(f'WARNING: encountered unknown type: {type(el)}')
result += '\n'
else:
print(f'WARNING: encountered unknown type: {type(el)}')
if section['uid'] > 0:
result += '=end=\n'
return result.strip()
def add_servoLinks(mfd_data,active=[True,True,True]): # directions on which to add PBC
base = ['x','y','z']
box = {'min': np.zeros(3,dtype='d'),
'max': np.zeros(3,dtype='d'),
'delta': np.zeros(3,dtype='d'),
}
mfd_dict = {}
for i in range(len(mfd_data)):
mfd_dict[mfd_data[i]['label']] = i
NodeCoords = np.array(mfd_data[mfd_dict['nodes']]['els'][1::4])[:,1:4]
Nnodes = NodeCoords.shape[0]
box['min'] = NodeCoords.min(axis=0) # find the bounding box
box['max'] = NodeCoords.max(axis=0)
box['delta'] = box['max']-box['min']
for coord in range(3): # calc the dimension of the bounding box
if box['delta'][coord] != 0.0:
for extremum in ['min','max']:
rounded = round(box[extremum][coord]*1e+15/box['delta'][coord]) * \
1e-15*box['delta'][coord] # rounding to 1e-15 of dimension
box[extremum][coord] = 0.0 if rounded == 0.0 else rounded # get rid of -0.0 (negative zeros)
baseNode = {}
linkNodes = []
#-------------------------------------------------------------------------------------------------
# loop over all nodes
for node in range(Nnodes):
key = {}
maxFlag = [False, False, False]
Nmax = 0
Nmin = 0
for coord in range(3): # for each direction
if box['delta'][coord] != 0.0:
rounded = round(NodeCoords[node,coord]*1e+15/box['delta'][coord]) * \
1e-15*box['delta'][coord] # rounding to 1e-15 of dimension
NodeCoords[node,coord] = 0.0 if rounded == 0.0 else rounded # get rid of -0.0 (negative zeros)
key[base[coord]] = "%.8e"%NodeCoords[node,coord] # translate position to string
if (key[base[coord]] == "%.8e"%box['min'][coord]): # compare to min of bounding box (i.e. is on outer face?)
Nmin += 1 # count outer (back) face membership
elif (key[base[coord]] == "%.8e"%box['max'][coord]): # compare to max of bounding box (i.e. is on outer face?)
Nmax += 1 # count outer (front) face membership
maxFlag[coord] = True # remember face membership (for linked nodes)
if Nmin > 0: # node is on a back face
# prepare for any non-existing entries in the data structure
if key['x'] not in baseNode.keys():
baseNode[key['x']] = {}
if key['y'] not in baseNode[key['x']].keys():
baseNode[key['x']][key['y']] = {}
if key['z'] not in baseNode[key['x']][key['y']].keys():
baseNode[key['x']][key['y']][key['z']] = 0
baseNode[key['x']][key['y']][key['z']] = node+1 # remember the base node id
if Nmax > 0 and Nmax >= Nmin: # node is on at least as many front than back faces
if any([maxFlag[i] and active[i] for i in range(3)]):
linkNodes.append({'id':node+1,'coord':NodeCoords[node],'faceMember':[maxFlag[i] and active[i] for i in range(3)]})
mfd_data[mfd_dict['entities']]['els'][0][0] += len(linkNodes) * 3
baseCorner = baseNode["%.8e"%box['min'][0]]["%.8e"%box['min'][1]]["%.8e"%box['min'][2]] # detect ultimate base node
links = {'uid': 1705, 'label': 'links', 'els': [[7,0],[9,0]]}
linkID = 0
for node in linkNodes: # loop over all linked nodes
linkCoord = [node['coord']] # start list of control node coords with my coords
for dir in range(3): # check for each direction
if node['faceMember'][dir]: # me on this front face
linkCoord[0][dir] = box['min'][dir] # project me onto rear face along dir
linkCoord.append(np.array(box['min'])) # append base corner
linkCoord[-1][dir] = box['max'][dir] # stretch it to corresponding control leg of "dir"
nLinks = len(linkCoord)
for dof in [1,2,3]:
tied_node = node['id']
nterms = 1 + nLinks
linkID += 1
# Link header
links['els'].append('link{0}\n'.format(linkID))
links['els'].append([linkID, 1])
links['els'].append([0])
links['els'].append([0])
links['els'].append([0, 0, 0, tied_node])
# these need to be put in groups of four
link_payload = [dof, 0, nterms]
# Individual node contributions (node, dof, coef.)
for i in range(nterms):
if i == nLinks:
link_payload.append(baseCorner)
else:
link_payload.append(baseNode["%.8e"%linkCoord[i][0]]["%.8e"%linkCoord[i][1]]["%.8e"%linkCoord[i][2]])
for i in range(nterms):
link_payload.append(dof)
for i in range(nterms):
if i == nLinks:
link_payload.append(1.0 - nLinks)
else:
link_payload.append(1.0)
# Needs to be formatted 4 data points per row, character width of 20, so 80 total
for j in range(0, len(link_payload), 4):
links['els'].append(link_payload[j:j+4])
if j+4 < len(link_payload):
links['els'].append(link_payload[j+4:])
i = 0
while i < len(mfd_data) and mfd_data[i]['uid'] < 1705: i += 1
if mfd_data[i]['uid'] == 1705: del mfd_data[i]
mfd_data.insert(i, links)
#--------------------------------------------------------------------------------------------------
# MAIN
#--------------------------------------------------------------------------------------------------
parser = OptionParser(usage='%prog options [file[s]]', description = """
Set up servo linking to achieve periodic boundary conditions for a regular hexahedral mesh.
Use *py_connection to operate on model presently opened in MSC.Mentat.
""", version = script_id)
parser.add_option('-p', '--port',
type = int, metavar = 'int', default = None,
help = 'Mentat connection port')
parser.add_option('-x',
action = 'store_false', default = True,
help = 'no PBC along x direction')
parser.add_option('-y',
action = 'store_false', default = True,
help = 'no PBC along y direction')
parser.add_option('-z',
action = 'store_false', default = True,
help = 'no PBC along z direction')
(options, filenames) = parser.parse_args()
remote = options.port is not None
if remote and filenames != []:
parser.error('file can not be specified when port is given.')
if filenames == []: filenames = [None]
if remote:
sys.path.append(str(damask.solver.Marc().library_path))
import py_mentat
print(script_name+': waiting to connect...')
filenames = [os.path.join(tempfile._get_default_tempdir(), next(tempfile._get_candidate_names()) + '.mfd')]
try:
py_mentat.py_connect('',options.port)
py_mentat.py_send('*set_save_formatted on')
py_mentat.py_send('*save_as_model "{}" yes'.format(filenames[0]))
py_mentat.py_get_int("nnodes()")
except py_mentat.InputError as err:
print(f'{err}. Try Tools/Python/"Run as Separate Process" & "Initiate".')
sys.exit(-1)
print( 'connected...')
for name in filenames:
while remote and not os.path.exists(name): time.sleep(0.5)
with open( name,'r') if name is not None else sys.stdin as file_in:
print(script_name+': '+name)
mfd = parseMFD(file_in)
add_servoLinks(mfd,[options.x,options.y,options.z])
with open( name,'w') if name is not None else sys.stdout as file_out:
file_out.write(asMFD(mfd))
if remote:
py_mentat.py_send('*open_model "{}"'.format(filenames[0]))

16
processing/pre/mentat_spectralBox.py → processing/mentat_spectralBox.py
View File

@ -7,8 +7,8 @@ from optparse import OptionParser
import damask import damask
scriptName = os.path.splitext(os.path.basename(__file__))[0] script_name = os.path.splitext(os.path.basename(__file__))[0]
scriptID = ' '.join([scriptName,damask.version]) script_id = ' '.join([script_name,damask.version])
#------------------------------------------------------------------------------------------------- #-------------------------------------------------------------------------------------------------
def outMentat(cmd,locals): def outMentat(cmd,locals):
@ -45,7 +45,7 @@ def output(cmds,locals,dest):
#------------------------------------------------------------------------------------------------- #-------------------------------------------------------------------------------------------------
def init(): def init():
return [ return [
"|"+' '.join([scriptID] + sys.argv[1:]), "|"+' '.join([script_id] + sys.argv[1:]),
"*draw_manual", # prevent redrawing in Mentat, should be much faster "*draw_manual", # prevent redrawing in Mentat, should be much faster
"*new_model yes", "*new_model yes",
"*reset", "*reset",
@ -170,7 +170,7 @@ def initial_conditions(material):
parser = OptionParser(usage='%prog options [file[s]]', description = """ parser = OptionParser(usage='%prog options [file[s]]', description = """
Generate MSC.Marc FE hexahedral mesh from geom file. Generate MSC.Marc FE hexahedral mesh from geom file.
""", version = scriptID) """, version = script_id)
parser.add_option('-p', '--port', parser.add_option('-p', '--port',
dest = 'port', dest = 'port',
@ -194,7 +194,7 @@ if options.port is not None:
if filenames == []: filenames = [None] if filenames == []: filenames = [None]
for name in filenames: for name in filenames:
print(scriptName+': '+name) print(script_name+': '+name)
geom = damask.Grid.load(StringIO(''.join(sys.stdin.read())) if name is None else name) geom = damask.Grid.load(StringIO(''.join(sys.stdin.read())) if name is None else name)
material = geom.material.flatten(order='F') material = geom.material.flatten(order='F')
@ -211,11 +211,11 @@ for name in filenames:
'*draw_automatic', '*draw_automatic',
] ]
outputLocals = {} output_locals = {}
if options.port: if options.port:
py_mentat.py_connect('',options.port) py_mentat.py_connect('',options.port)
output(cmds,outputLocals,'Mentat') output(cmds,output_locals,'Mentat')
py_mentat.py_disconnect() py_mentat.py_disconnect()
else: else:
with sys.stdout if name is None else open(os.path.splitext(name)[0]+'.proc','w') as f: with sys.stdout if name is None else open(os.path.splitext(name)[0]+'.proc','w') as f:
output(cmds,outputLocals,f) output(cmds,output_locals,f)

262
processing/pre/mentat_pbcOnBoxMesh.py
View File

@ -1,262 +0,0 @@
#!/usr/bin/env python3
import sys
import os
import re
import time
import tempfile
from optparse import OptionParser
import numpy as np
import damask
scriptName = os.path.splitext(os.path.basename(__file__))[0]
scriptID = ' '.join([scriptName,damask.version])
# Convert .mfd file into a usable format
# Broken into labeled sections (eg. nodes, links, etc)
# Each section has a list of labeled elements with formatted numerical data
def parseMFD(dat):
formatted = []
section = 0
formatted.append({'label': 'header', 'uid': -1, 'els': []})
# in between =beg= and =end= part of file
in_block = False
for line in dat:
if in_block: # currently in a section
# lines that start with a space are numerical data
if line[0] == ' ':
formatted[section]['els'].append([])
# grab numbers
nums = re.split(r'\s+', line.strip())
for num in nums:
# floating point has format ' -x.xxxxxxxxxxxxe+yy'
# scientific notation is used for float
if (len(num) >= 4) and (num[-4] == 'e'):
formatted[section]['els'][-1].append(float(num))
else: # integer
formatted[section]['els'][-1].append(int(num))
else: # not numerical data, so it is a label for an element or section end
if line[0] == '=' and re.search(r'=end=$', line) is not None: # End of section, avoiding regex if possible
in_block = False
else:
formatted[section]['els'].append([])
formatted[section]['els'][-1] = line
else: # Not in a section, we are looking for a =beg= now
search = re.search(r'=beg=\s+(\d+)\s\((.*?)\)', line)
if search is not None: # found start of a new section
section += 1
in_block = True
formatted.append({'label': search.group(2), 'uid': int(search.group(1)), 'els': []})
else: # No =beg= found, probably in the header
# Either header or somthing we didn't plan for - just save the line so it isn't lost
if formatted[section]['uid'] > 0:
section += 1
formatted.append({'label': '', 'uid': -2, 'els': []}) # make dummy section to store unrecognized data
formatted[section]['els'].append(line)
return formatted
def asMFD(mfd_data):
result = ''
for section in mfd_data:
if section['uid'] > 0:
result += '=beg={0:5d} ({1})\n'.format(section['uid'], section['label'])
for el in section['els']:
if type(el) == str:
result += el
elif type(el) == list:
for num in el:
if type(num) == int:
result += '{:20d}'.format(num)
elif type(num) == float:
result += '{:20.12e}'.format(num)
else:
print(f'WARNING: encountered unknown type: {type(el)}')
result += '\n'
else:
print(f'WARNING: encountered unknown type: {type(el)}')
if section['uid'] > 0:
result += '=end=\n'
return result.strip()
def add_servoLinks(mfd_data,active=[True,True,True]): # directions on which to add PBC
base = ['x','y','z']
box = {'min': np.zeros(3,dtype='d'),
'max': np.zeros(3,dtype='d'),
'delta': np.zeros(3,dtype='d'),
}
mfd_dict = {}
for i in range(len(mfd_data)):
mfd_dict[mfd_data[i]['label']] = i
NodeCoords = np.array(mfd_data[mfd_dict['nodes']]['els'][1::4])[:,1:4]
Nnodes = NodeCoords.shape[0]
box['min'] = NodeCoords.min(axis=0) # find the bounding box
box['max'] = NodeCoords.max(axis=0)
box['delta'] = box['max']-box['min']
for coord in range(3): # calc the dimension of the bounding box
if box['delta'][coord] != 0.0:
for extremum in ['min','max']:
rounded = round(box[extremum][coord]*1e+15/box['delta'][coord]) * \
1e-15*box['delta'][coord] # rounding to 1e-15 of dimension
box[extremum][coord] = 0.0 if rounded == 0.0 else rounded # get rid of -0.0 (negative zeros)
baseNode = {}
linkNodes = []
#-------------------------------------------------------------------------------------------------
# loop over all nodes
for node in range(Nnodes):
key = {}
maxFlag = [False, False, False]
Nmax = 0
Nmin = 0
for coord in range(3): # for each direction
if box['delta'][coord] != 0.0:
rounded = round(NodeCoords[node,coord]*1e+15/box['delta'][coord]) * \
1e-15*box['delta'][coord] # rounding to 1e-15 of dimension
NodeCoords[node,coord] = 0.0 if rounded == 0.0 else rounded # get rid of -0.0 (negative zeros)
key[base[coord]] = "%.8e"%NodeCoords[node,coord] # translate position to string
if (key[base[coord]] == "%.8e"%box['min'][coord]): # compare to min of bounding box (i.e. is on outer face?)
Nmin += 1 # count outer (back) face membership
elif (key[base[coord]] == "%.8e"%box['max'][coord]): # compare to max of bounding box (i.e. is on outer face?)
Nmax += 1 # count outer (front) face membership
maxFlag[coord] = True # remember face membership (for linked nodes)
if Nmin > 0: # node is on a back face
# prepare for any non-existing entries in the data structure
if key['x'] not in baseNode.keys():
baseNode[key['x']] = {}
if key['y'] not in baseNode[key['x']].keys():
baseNode[key['x']][key['y']] = {}
if key['z'] not in baseNode[key['x']][key['y']].keys():
baseNode[key['x']][key['y']][key['z']] = 0
baseNode[key['x']][key['y']][key['z']] = node+1 # remember the base node id
if Nmax > 0 and Nmax >= Nmin: # node is on at least as many front than back faces
if any([maxFlag[i] and active[i] for i in range(3)]):
linkNodes.append({'id': node+1,'coord': NodeCoords[node], 'faceMember': [maxFlag[i] and active[i] for i in range(3)]})
mfd_data[mfd_dict['entities']]['els'][0][0] += len(linkNodes) * 3
baseCorner = baseNode["%.8e"%box['min'][0]]["%.8e"%box['min'][1]]["%.8e"%box['min'][2]] # detect ultimate base node
links = {'uid': 1705, 'label': 'links', 'els': [[7,0],[9,0]]}
linkID = 0
for node in linkNodes: # loop over all linked nodes
linkCoord = [node['coord']] # start list of control node coords with my coords
for dir in range(3): # check for each direction
if node['faceMember'][dir]: # me on this front face
linkCoord[0][dir] = box['min'][dir] # project me onto rear face along dir
linkCoord.append(np.array(box['min'])) # append base corner
linkCoord[-1][dir] = box['max'][dir] # stretch it to corresponding control leg of "dir"
nLinks = len(linkCoord)
for dof in [1,2,3]:
tied_node = node['id']
nterms = 1 + nLinks
linkID += 1
# Link header
links['els'].append('link{0}\n'.format(linkID))
links['els'].append([linkID, 1])
links['els'].append([0])
links['els'].append([0])
links['els'].append([0, 0, 0, tied_node])
# these need to be put in groups of four
link_payload = [dof, 0, nterms]
# Individual node contributions (node, dof, coef.)
for i in range(nterms):
if i == nLinks:
link_payload.append(baseCorner)
else:
link_payload.append(baseNode["%.8e"%linkCoord[i][0]]["%.8e"%linkCoord[i][1]]["%.8e"%linkCoord[i][2]])
for i in range(nterms):
link_payload.append(dof)
for i in range(nterms):
if i == nLinks:
link_payload.append(1.0 - nLinks)
else:
link_payload.append(1.0)
# Needs to be formatted 4 data points per row, character width of 20, so 80 total
for j in range(0, len(link_payload), 4):
links['els'].append(link_payload[j:j+4])
if j+4 < len(link_payload):
links['els'].append(link_payload[j+4:])
i = 0
while i < len(mfd_data) and mfd_data[i]['uid'] < 1705: i += 1
if mfd_data[i]['uid'] == 1705: del mfd_data[i]
mfd_data.insert(i, links)
#--------------------------------------------------------------------------------------------------
# MAIN
#--------------------------------------------------------------------------------------------------
parser = OptionParser(usage='%prog options [file[s]]', description = """
Set up servo linking to achieve periodic boundary conditions for a regular hexahedral mesh.
Use *py_connection to operate on model presently opened in MSC.Mentat.
""", version = scriptID)
parser.add_option('-p', '--port',
type = int, metavar = 'int', default = None,
help = 'Mentat connection port')
parser.add_option('-x',
action = 'store_false', default = True,
help = 'no PBC along x direction')
parser.add_option('-y',
action = 'store_false', default = True,
help = 'no PBC along y direction')
parser.add_option('-z',
action = 'store_false', default = True,
help = 'no PBC along z direction')
(options, filenames) = parser.parse_args()
remote = options.port is not None
if remote and filenames != []:
parser.error('file can not be specified when port is given.')
if filenames == []: filenames = [None]
if remote:
sys.path.append(str(damask.solver.Marc().library_path))
import py_mentat
print(scriptName+': waiting to connect...')
filenames = [os.path.join(tempfile._get_default_tempdir(), next(tempfile._get_candidate_names()) + '.mfd')]
try:
py_mentat.py_connect('',options.port)
py_mentat.py_send('*set_save_formatted on')
py_mentat.py_send('*save_as_model "{}" yes'.format(filenames[0]))
py_mentat.py_get_int("nnodes()")
except py_mentat.InputError as err:
print(f'{err}. Try Tools/Python/"Run as Separate Process" & "Initiate".')
sys.exit(-1)
print( 'connected...')
for name in filenames:
while remote and not os.path.exists(name): time.sleep(0.5)
with open( name,'r') if name is not None else sys.stdin as fileIn:
print(scriptName+': '+name)
mfd = parseMFD(fileIn)
add_servoLinks(mfd,[options.x,options.y,options.z])
with open( name,'w') if name is not None else sys.stdout as fileOut:
fileOut.write(asMFD(mfd))
if remote:
py_mentat.py_send('*open_model "{}"'.format(filenames[0]))

16
python/damask/_config.py
View File

@ -8,8 +8,10 @@ import numpy as np
import yaml import yaml
try: try:
from yaml import CSafeLoader as SafeLoader from yaml import CSafeLoader as SafeLoader
from yaml import CSafeDumper as SafeDumper
except ImportError: except ImportError:
from yaml import SafeLoader # type: ignore from yaml import SafeLoader # type: ignore
from yaml import SafeDumper # type: ignore
from ._typehints import FileHandle from ._typehints import FileHandle
from . import Rotation from . import Rotation
@ -17,20 +19,20 @@ from . import util
MyType = TypeVar('MyType', bound='Config') MyType = TypeVar('MyType', bound='Config')
class NiceDumper(yaml.SafeDumper): class NiceDumper(SafeDumper):
"""Make YAML readable for humans.""" """Make YAML readable for humans."""
def write_line_break(self, def write_line_break(self,
data: Optional[str] = None): data: Optional[str] = None):
super().write_line_break(data) super().write_line_break(data) # type: ignore
if len(self.indents) == 1: if len(self.indents) == 1: # type: ignore
super().write_line_break() super().write_line_break() # type: ignore
def increase_indent(self, def increase_indent(self,
flow: bool = False, flow: bool = False,
indentless: bool = False): indentless: bool = False):
return super().increase_indent(flow, False) return super().increase_indent(flow, False) # type: ignore
def represent_data(self, def represent_data(self,
data: Any): data: Any):
@ -41,7 +43,9 @@ class NiceDumper(yaml.SafeDumper):
return self.represent_data(data.tolist()) return self.represent_data(data.tolist())
if isinstance(data, Rotation): if isinstance(data, Rotation):
return self.represent_data(data.quaternion.tolist()) return self.represent_data(data.quaternion.tolist())
else: if hasattr(data, 'dtype'):
return self.represent_data(data.item())
return super().represent_data(data) return super().represent_data(data)
def ignore_aliases(self, def ignore_aliases(self,

30
python/damask/_grid.py
View File

@ -19,6 +19,14 @@ from . import Rotation
from . import Table from . import Table
from . import Colormap from . import Colormap
from ._typehints import FloatSequence, IntSequence, IntCollection, NumpyRngSeed from ._typehints import FloatSequence, IntSequence, IntCollection, NumpyRngSeed
try:
import numba as nb # type: ignore
except ImportError:
nb = False
def numba_njit_wrapper(**kwargs):
return (lambda function: nb.njit(function) if nb else function)
class Grid: class Grid:
""" """
@ -1129,7 +1137,7 @@ class Grid:
""" """
def most_frequent(stencil: np.ndarray, def most_frequent(stencil: np.ndarray,
selection: Union[None,set], selection: Union[None,set],
rng): rng: np.random.Generator):
me = stencil[stencil.size//2] me = stencil[stencil.size//2]
if selection is None or me in selection: if selection is None or me in selection:
unique, counts = np.unique(stencil,return_counts=True) unique, counts = np.unique(stencil,return_counts=True)
@ -1289,19 +1297,27 @@ class Grid:
Updated grid-based geometry. Updated grid-based geometry.
""" """
def tainted_neighborhood(stencil: np.ndarray, selection: Union[None,set]): @numba_njit_wrapper()
def tainted_neighborhood(stencil: np.ndarray,
selection: Optional[np.ndarray] = None):
me = stencil[stencil.size//2] me = stencil[stencil.size//2]
return np.any(stencil != me if selection is None else if selection is None:
np.in1d(stencil,np.array(list(selection - {me})))) return np.any(stencil != me)
elif not len(selection)==0:
for stencil_item in stencil:
for selection_item in selection:
if stencil_item==selection_item and selection_item!=me:
return True
return False
d = np.floor(distance).astype(np.int64) d = np.floor(distance).astype(np.int64)
ext = np.linspace(-d,d,1+2*d,dtype=float), ext = np.linspace(-d,d,1+2*d,dtype=float),
xx,yy,zz = np.meshgrid(ext,ext,ext) xx,yy,zz = np.meshgrid(ext,ext,ext)
footprint = xx**2+yy**2+zz**2 <= distance**2+distance*1e-8 footprint = xx**2+yy**2+zz**2 <= distance**2+distance*1e-8
offset_ = np.nanmax(self.material)+1 if offset is None else offset offset_ = np.nanmax(self.material)+1 if offset is None else offset
selection_ = None if selection is None else \ selection_ = None if selection is None else \
set(self.material.flatten()) - set(util.aslist(selection)) if invert_selection else \ np.array(list(set(self.material.flatten()) - set(util.aslist(selection)))) if invert_selection else \
set(self.material.flatten()) & set(util.aslist(selection)) np.array(list(set(self.material.flatten()) & set(util.aslist(selection))))
mask = ndimage.generic_filter(self.material, mask = ndimage.generic_filter(self.material,
tainted_neighborhood, tainted_neighborhood,
footprint=footprint, footprint=footprint,

29
python/damask/_orientation.py
View File

@ -627,7 +627,7 @@ class Orientation(Rotation,Crystal):
weights : numpy.ndarray, shape (self.shape), optional weights : numpy.ndarray, shape (self.shape), optional
Relative weights of orientations. Relative weights of orientations.
return_cloud : bool, optional return_cloud : bool, optional
Return the set of symmetrically equivalent orientations that was used in averaging. Return the specific (symmetrically equivalent) orientations that were averaged.
Defaults to False. Defaults to False.
Returns Returns
@ -635,7 +635,7 @@ class Orientation(Rotation,Crystal):
average : Orientation average : Orientation
Weighted average of original Orientation field. Weighted average of original Orientation field.
cloud : Orientations, conditional cloud : Orientations, conditional
Set of symmetrically equivalent orientations that were used in averaging. Symmetrically equivalent version of each orientation that were actually used in averaging.
References References
---------- ----------
@ -660,7 +660,7 @@ class Orientation(Rotation,Crystal):
proper: bool = False, proper: bool = False,
return_operators: bool = False) -> np.ndarray: return_operators: bool = False) -> np.ndarray:
""" """
Rotate vector to ensure it falls into (improper or proper) standard stereographic triangle of crystal symmetry. Rotate lab frame vector to ensure it falls into (improper or proper) standard stereographic triangle of crystal symmetry.
Parameters Parameters
---------- ----------
@ -679,7 +679,7 @@ class Orientation(Rotation,Crystal):
------- -------
vector_SST : numpy.ndarray, shape (...,3) vector_SST : numpy.ndarray, shape (...,3)
Rotated vector falling into SST. Rotated vector falling into SST.
operators : numpy.ndarray of int, shape (...), conditional operator : numpy.ndarray of int, shape (...), conditional
Index of symmetrically equivalent orientation that rotated vector to SST. Index of symmetrically equivalent orientation that rotated vector to SST.
""" """
@ -749,12 +749,12 @@ class Orientation(Rotation,Crystal):
in_SST: bool = True, in_SST: bool = True,
proper: bool = False) -> np.ndarray: proper: bool = False) -> np.ndarray:
""" """
Map vector to RGB color within standard stereographic triangle of own symmetry. Map lab frame vector to RGB color within standard stereographic triangle of own symmetry.
Parameters Parameters
---------- ----------
vector : numpy.ndarray, shape (...,3) vector : numpy.ndarray, shape (...,3)
Vector to colorize. Lab frame vector to colorize.
Shape of vector blends with shape of own rotation array. Shape of vector blends with shape of own rotation array.
For example, a rotation array of shape (3,2) and a vector array of shape (2,4) result in (3,2,4) outputs. For example, a rotation array of shape (3,2) and a vector array of shape (2,4) result in (3,2,4) outputs.
in_SST : bool, optional in_SST : bool, optional
@ -771,13 +771,26 @@ class Orientation(Rotation,Crystal):
Examples Examples
-------- --------
Inverse pole figure color of the e_3 direction for a crystal in "Cube" orientation with cubic symmetry: Inverse pole figure color of the e_3 lab direction for a
crystal in "Cube" orientation with cubic symmetry:
>>> import damask >>> import damask
>>> o = damask.Orientation(family='cubic') >>> o = damask.Orientation(family='cubic')
>>> o.IPF_color([0,0,1]) >>> o.IPF_color([0,0,1])
array([1., 0., 0.]) array([1., 0., 0.])
Sample standard triangle for hexagonal symmetry:
>>> import damask
>>> from matplotlib import pyplot as plt
>>> lab = [0,0,1]
>>> o = damask.Orientation.from_random(shape=500000,family='hexagonal')
>>> coord = damask.util.project_equal_area(o.to_SST(lab))
>>> color = o.IPF_color(lab)
>>> plt.scatter(coord[:,0],coord[:,1],color=color,s=.06)
>>> plt.axis('scaled')
>>> plt.show()
""" """
if np.array(vector).shape[-1] != 3: if np.array(vector).shape[-1] != 3:
raise ValueError('input is not a field of three-dimensional vectors') raise ValueError('input is not a field of three-dimensional vectors')
@ -807,7 +820,7 @@ class Orientation(Rotation,Crystal):
in_SST_ = np.all(components >= 0.0,axis=-1) in_SST_ = np.all(components >= 0.0,axis=-1)
with np.errstate(invalid='ignore',divide='ignore'): with np.errstate(invalid='ignore',divide='ignore'):
rgb = (components/np.linalg.norm(components,axis=-1,keepdims=True))**0.5 # smoothen color ramps rgb = (components/np.linalg.norm(components,axis=-1,keepdims=True))**(1./3.) # smoothen color ramps
rgb = np.clip(rgb,0.,1.) # clip intensity rgb = np.clip(rgb,0.,1.) # clip intensity
rgb /= np.max(rgb,axis=-1,keepdims=True) # normalize to (HS)V = 1 rgb /= np.max(rgb,axis=-1,keepdims=True) # normalize to (HS)V = 1
rgb[np.broadcast_to(~in_SST_[...,np.newaxis],rgb.shape)] = 0.0 rgb[np.broadcast_to(~in_SST_[...,np.newaxis],rgb.shape)] = 0.0

18
python/damask/grid_filters.py
View File

@ -75,8 +75,8 @@ def curl(size: _FloatSequence,
e[0, 2, 1] = e[2, 1, 0] = e[1, 0, 2] = -1.0 e[0, 2, 1] = e[2, 1, 0] = e[1, 0, 2] = -1.0
f_fourier = _np.fft.rfftn(f,axes=(0,1,2)) f_fourier = _np.fft.rfftn(f,axes=(0,1,2))
curl_ = (_np.einsum('slm,ijkl,ijkm ->ijks', e,k_s,f_fourier)*2.0j*_np.pi if n == 3 else # vector, 3 -> 3 curl_ = (_np.einsum('slm,ijkl,ijkm ->ijks' if n == 3 else
_np.einsum('slm,ijkl,ijknm->ijksn',e,k_s,f_fourier)*2.0j*_np.pi) # tensor, 3x3 -> 3x3 'slm,ijkl,ijknm->ijksn',e,k_s,f_fourier)*2.0j*_np.pi) # vector 3->3, tensor 3x3->3x3
return _np.fft.irfftn(curl_,axes=(0,1,2),s=f.shape[:3]) return _np.fft.irfftn(curl_,axes=(0,1,2),s=f.shape[:3])
@ -103,10 +103,10 @@ def divergence(size: _FloatSequence,
k_s = _ks(size,f.shape[:3],True) k_s = _ks(size,f.shape[:3],True)
f_fourier = _np.fft.rfftn(f,axes=(0,1,2)) f_fourier = _np.fft.rfftn(f,axes=(0,1,2))
div_ = (_np.einsum('ijkl,ijkl ->ijk', k_s,f_fourier)*2.0j*_np.pi if n == 3 else # vector, 3 -> 1 divergence_ = (_np.einsum('ijkl,ijkl ->ijk' if n == 3 else
_np.einsum('ijkm,ijklm->ijkl',k_s,f_fourier)*2.0j*_np.pi) # tensor, 3x3 -> 3 'ijkm,ijklm->ijkl', k_s,f_fourier)*2.0j*_np.pi) # vector 3->1, tensor 3x3->3
return _np.fft.irfftn(div_,axes=(0,1,2),s=f.shape[:3]) return _np.fft.irfftn(divergence_,axes=(0,1,2),s=f.shape[:3])
def gradient(size: _FloatSequence, def gradient(size: _FloatSequence,
@ -124,17 +124,17 @@ def gradient(size: _FloatSequence,
Returns Returns
------- -------
∇ f : numpy.ndarray, shape (:,:,:,3) or (:,:,:,3,3) ∇ f : numpy.ndarray, shape (:,:,:,3) or (:,:,:,3,3)
Divergence of f. Gradient of f.
""" """
n = _np.prod(f.shape[3:]) n = _np.prod(f.shape[3:])
k_s = _ks(size,f.shape[:3],True) k_s = _ks(size,f.shape[:3],True)
f_fourier = _np.fft.rfftn(f,axes=(0,1,2)) f_fourier = _np.fft.rfftn(f,axes=(0,1,2))
grad_ = (_np.einsum('ijkl,ijkm->ijkm', f_fourier,k_s)*2.0j*_np.pi if n == 1 else # scalar, 1 -> 3 gradient_ = (_np.einsum('ijkl,ijkm->ijkm' if n == 1 else
_np.einsum('ijkl,ijkm->ijklm',f_fourier,k_s)*2.0j*_np.pi) # vector, 3 -> 3x3 'ijkl,ijkm->ijklm',f_fourier,k_s)*2.0j*_np.pi) # scalar 1->3, vector 3->3x3
return _np.fft.irfftn(grad_,axes=(0,1,2),s=f.shape[:3]) return _np.fft.irfftn(gradient_,axes=(0,1,2),s=f.shape[:3])
def coordinates0_point(cells: _IntSequence, def coordinates0_point(cells: _IntSequence,

3
python/tests/test_Config.py
View File

@ -46,7 +46,8 @@ class TestConfig:
assert Config.load(tmp_path/'config.yaml') == config assert Config.load(tmp_path/'config.yaml') == config
def test_numpy(self,tmp_path): def test_numpy(self,tmp_path):
assert Config({'A':np.ones(3,'i')}).__repr__() == Config({'A':[1,1,1]}).__repr__() assert Config({'A':np.ones(3,'i'), 'B':np.ones(1)[0]}).__repr__() == \
Config({'A':[1,1,1], 'B':1.0}).__repr__()
def test_abstract_is_valid(self): def test_abstract_is_valid(self):
with pytest.raises(NotImplementedError): with pytest.raises(NotImplementedError):

244
python/tests/test_Rotation.py
View File

@ -7,6 +7,7 @@ from damask import Table
from damask import _rotation from damask import _rotation
from damask import grid_filters from damask import grid_filters
from damask import util from damask import util
from damask import tensor
n = 1000 n = 1000
atol=1.e-4 atol=1.e-4
@ -20,6 +21,16 @@ def ref_path(ref_path_base):
def set_of_rotations(set_of_quaternions): def set_of_rotations(set_of_quaternions):
return [Rotation.from_quaternion(s) for s in set_of_quaternions] return [Rotation.from_quaternion(s) for s in set_of_quaternions]
@pytest.fixture
def multidim_rotations(set_of_quaternions):
L = len(set_of_quaternions)
i = 0
while L%(f:=np.random.randint(2,np.sqrt(L).astype(int))) > 0 and i<L:
i += 1
f = i if i == L else f
return Rotation.from_quaternion(set_of_quaternions.reshape((L//f,f,-1)))
#################################################################################################### ####################################################################################################
# Code below available according to the following conditions # Code below available according to the following conditions
@ -691,117 +702,156 @@ class TestRotation:
def test_to_numpy(self): def test_to_numpy(self):
r = Rotation.from_random(np.random.randint(0,10,4)) r = Rotation.from_random(np.random.randint(0,10,4))
assert np.all(r.as_quaternion() == np.array(r)) assert (r.as_quaternion() == np.array(r)).all()
@pytest.mark.parametrize('degrees',[True,False]) def test_bounds(self,multidim_rotations):
def test_Eulers(self,set_of_rotations,degrees): m = multidim_rotations
for rot in set_of_rotations:
m = rot.as_quaternion()
o = Rotation.from_Euler_angles(rot.as_Euler_angles(degrees),degrees).as_quaternion()
ok = np.allclose(m,o,atol=atol)
if np.isclose(rot.as_quaternion()[0],0.0,atol=atol):
ok |= np.allclose(m*-1.,o,atol=atol)
assert ok and np.isclose(np.linalg.norm(o),1.0), f'{m},{o},{rot.as_quaternion()}'
@pytest.mark.parametrize('P',[1,-1]) q = m.as_quaternion()
@pytest.mark.parametrize('normalize',[True,False]) assert np.allclose(1.,np.linalg.norm(q,axis=-1))
@pytest.mark.parametrize('degrees',[True,False])
def test_axis_angle(self,set_of_rotations,degrees,normalize,P):
c = np.array([P*-1,P*-1,P*-1,1.])
c[:3] *= 0.9 if normalize else 1.0
for rot in set_of_rotations:
m = rot.as_Euler_angles()
o = Rotation.from_axis_angle(rot.as_axis_angle(degrees)*c,degrees,normalize,P).as_Euler_angles()
u = np.array([np.pi*2,np.pi,np.pi*2])
ok = np.allclose(m,o,atol=atol)
ok |= np.allclose(np.where(np.isclose(m,u),m-u,m),np.where(np.isclose(o,u),o-u,o),atol=atol)
if np.isclose(m[1],0.0,atol=atol) or np.isclose(m[1],np.pi,atol=atol):
sum_phi = np.unwrap([m[0]+m[2],o[0]+o[2]])
ok |= np.isclose(sum_phi[0],sum_phi[1],atol=atol)
assert ok and (np.zeros(3)-1.e-9 <= o).all() \
and (o <= np.array([np.pi*2.,np.pi,np.pi*2.])+1.e-9).all(), f'{m},{o},{rot.as_quaternion()}'
def test_matrix(self,set_of_rotations): v = m.as_Rodrigues_vector(compact=False)
for rot in set_of_rotations: assert np.allclose(1.,np.linalg.norm(v[...,:3],axis=-1))
m = rot.as_axis_angle()
o = Rotation.from_axis_angle(rot.as_axis_angle()).as_axis_angle()
ok = np.allclose(m,o,atol=atol)
if np.isclose(m[3],np.pi,atol=atol):
ok |= np.allclose(m*np.array([-1.,-1.,-1.,1.]),o,atol=atol)
assert ok and np.isclose(np.linalg.norm(o[:3]),1.0) \
and o[3]<=np.pi+1.e-9, f'{m},{o},{rot.as_quaternion()}'
def test_parallel(self,set_of_rotations): v = m.as_axis_angle(degrees=False)
a = np.array([[1.0,0.0,0.0], assert np.allclose(1.,np.linalg.norm(v[...,:3],axis=-1))
[0.0,1.0,0.0]]) assert (v[...,3] >= 0.).all and (v < np.pi+1.e-9).all()
for rot in set_of_rotations:
assert rot.allclose(Rotation.from_parallel(a,rot.broadcast_to((2,))@a))
@pytest.mark.parametrize('P',[1,-1]) r = m.as_matrix()
@pytest.mark.parametrize('normalize',[True,False]) assert np.allclose(1.,np.linalg.det(r))
def test_Rodrigues(self,set_of_rotations,normalize,P):
c = np.array([P*-1,P*-1,P*-1,1.])
c[:3] *= 0.9 if normalize else 1.0
for rot in set_of_rotations:
m = rot.as_matrix()
o = Rotation.from_Rodrigues_vector(rot.as_Rodrigues_vector()*c,normalize,P).as_matrix()
ok = np.allclose(m,o,atol=atol)
assert ok and np.isclose(np.linalg.det(o),1.0), f'{m},{o}'
def test_Rodrigues_compact(self,set_of_rotations): e = m.as_Euler_angles(degrees=False)
for rot in set_of_rotations: assert (e >= 0.).all and (e < np.pi*np.array([2.,1.,2.])+1.e-9).all()
c = rot.as_Rodrigues_vector(compact=True)
r = rot.as_Rodrigues_vector(compact=False) c = m.as_cubochoric()
assert np.allclose(r[:3]*r[3], c, equal_nan=True) assert (np.linalg.norm(c,ord=np.inf,axis=-1) < np.pi**(2./3.)*0.5+1.e-9).all()
h = m.as_homochoric()
assert (np.linalg.norm(h,axis=-1) < (3.*np.pi/4.)**(1./3.) + 1.e-9).all()
@pytest.mark.parametrize('P',[1,-1])
def test_homochoric(self,set_of_rotations,P):
cutoff = np.tan(np.pi*.5*(1.-1e-4))
for rot in set_of_rotations:
m = rot.as_Rodrigues_vector()
o = Rotation.from_homochoric(rot.as_homochoric()*P*-1,P).as_Rodrigues_vector()
ok = np.allclose(np.clip(m,None,cutoff),np.clip(o,None,cutoff),atol=atol)
ok |= np.isclose(m[3],0.0,atol=atol)
assert ok and np.isclose(np.linalg.norm(o[:3]),1.0), f'{m},{o},{rot.as_quaternion()}'
@pytest.mark.parametrize('P',[1,-1])
def test_cubochoric(self,set_of_rotations,P):
for rot in set_of_rotations:
m = rot.as_homochoric()
o = Rotation.from_cubochoric(rot.as_cubochoric()*P*-1,P).as_homochoric()
ok = np.allclose(m,o,atol=atol)
assert ok and np.linalg.norm(o) < (3.*np.pi/4.)**(1./3.) + 1.e-9, f'{m},{o},{rot.as_quaternion()}'
@pytest.mark.parametrize('P',[1,-1])
@pytest.mark.parametrize('accept_homomorph',[True,False]) @pytest.mark.parametrize('accept_homomorph',[True,False])
@pytest.mark.parametrize('normalize',[True,False]) @pytest.mark.parametrize('normalize',[True,False])
def test_quaternion(self,set_of_rotations,P,accept_homomorph,normalize): @pytest.mark.parametrize('P',[1,-1])
c = np.array([1,P*-1,P*-1,P*-1]) * (-1 if accept_homomorph else 1) * (0.9 if normalize else 1.0) def test_quaternion(self,multidim_rotations,accept_homomorph,normalize,P):
for rot in set_of_rotations: c = np.array([1,-P,-P,-P]) * (-1 if accept_homomorph else 1) * (0.9 if normalize else 1.0)
m = rot.as_cubochoric() m = multidim_rotations
o = Rotation.from_quaternion(rot.as_quaternion()*c,accept_homomorph,normalize,P).as_cubochoric() o = Rotation.from_quaternion(m.as_quaternion()*c,
ok = np.allclose(m,o,atol=atol) accept_homomorph=accept_homomorph,
if np.count_nonzero(np.isclose(np.abs(o),np.pi**(2./3.)*.5)): normalize=normalize,
ok |= np.allclose(m*-1.,o,atol=atol) P=P)
assert ok and o.max() < np.pi**(2./3.)*0.5+1.e-9, f'{m},{o},{rot.as_quaternion()}' f = Rotation(np.where(np.isclose(m.as_quaternion()[...,0],0.0,atol=atol)[...,np.newaxis],~o,o))
assert np.logical_or(m.isclose(o,atol=atol),
m.isclose(f,atol=atol)
).all()
@pytest.mark.parametrize('degrees',[True,False])
def test_Eulers(self,multidim_rotations,degrees):
m = multidim_rotations
o = Rotation.from_Euler_angles(m.as_Euler_angles(degrees),
degrees=degrees)
f = Rotation(np.where(np.isclose(m.as_quaternion()[...,0],0.0,atol=atol)[...,np.newaxis],~o,o))
assert np.logical_or(m.isclose(o,atol=atol),
m.isclose(f,atol=atol)
).all()
@pytest.mark.parametrize('degrees',[True,False])
@pytest.mark.parametrize('normalize',[True,False])
@pytest.mark.parametrize('P',[1,-1])
def test_axis_angle(self,multidim_rotations,degrees,normalize,P):
c = np.array([-P,-P,-P,1.])
c[:3] *= 0.9 if normalize else 1.0
m = multidim_rotations
o = Rotation.from_axis_angle(m.as_axis_angle(degrees)*c,
degrees=degrees,
normalize=normalize,
P=P)
f = Rotation(np.where(np.isclose(m.as_quaternion()[...,0],0.0,atol=atol)[...,np.newaxis],~o,o))
assert np.logical_or(m.isclose(o,atol=atol),
m.isclose(f,atol=atol)
).all()
def test_matrix(self,multidim_rotations):
m = multidim_rotations
o = Rotation.from_matrix(m.as_matrix())
f = Rotation(np.where(np.isclose(m.as_quaternion()[...,0],0.0,atol=atol)[...,np.newaxis],~o,o))
assert np.logical_or(m.isclose(o,atol=atol),
m.isclose(f,atol=atol)
).all()
def test_parallel(self,multidim_rotations):
m = multidim_rotations
a = np.broadcast_to(np.array([[1.0,0.0,0.0],
[0.0,1.0,0.0]]),m.shape+(2,3))
assert m.allclose(Rotation.from_parallel(a,m.broadcast_to(m.shape+(2,))@a))
@pytest.mark.parametrize('normalize',[True,False])
@pytest.mark.parametrize('P',[1,-1])
def test_Rodrigues(self,multidim_rotations,normalize,P):
c = np.array([-P,-P,-P,1.])
c[:3] *= 0.9 if normalize else 1.0
m = multidim_rotations
o = Rotation.from_Rodrigues_vector(m.as_Rodrigues_vector()*c,
normalize=normalize,
P=P)
f = Rotation(np.where(np.isclose(m.as_quaternion()[...,0],0.0,atol=atol)[...,np.newaxis],~o,o))
assert np.logical_or(m.isclose(o,atol=atol),
m.isclose(f,atol=atol)
).all()
def test_Rodrigues_compact(self,multidim_rotations):
m = multidim_rotations
c = m.as_Rodrigues_vector(compact=True)
r = m.as_Rodrigues_vector(compact=False)
assert np.allclose(r[...,:3]*r[...,3:], c, equal_nan=True)
@pytest.mark.parametrize('P',[1,-1])
def test_homochoric(self,multidim_rotations,P):
m = multidim_rotations
o = Rotation.from_homochoric(m.as_homochoric()*-P,
P=P)
f = Rotation(np.where(np.isclose(m.as_quaternion()[...,0],0.0,atol=atol)[...,np.newaxis],~o,o))
assert np.logical_or(m.isclose(o,atol=atol),
m.isclose(f,atol=atol)
).all()
@pytest.mark.parametrize('P',[1,-1])
def test_cubochoric(self,multidim_rotations,P):
m = multidim_rotations
o = Rotation.from_cubochoric(m.as_cubochoric()*-P,
P=P)
f = Rotation(np.where(np.isclose(m.as_quaternion()[...,0],0.0,atol=atol)[...,np.newaxis],~o,o))
assert np.logical_or(m.isclose(o,atol=atol),
m.isclose(f,atol=atol)
).all()
@pytest.mark.parametrize('reciprocal',[True,False]) @pytest.mark.parametrize('reciprocal',[True,False])
def test_basis(self,set_of_rotations,reciprocal): def test_basis(self,multidim_rotations,reciprocal):
for rot in set_of_rotations: m = multidim_rotations
om = rot.as_matrix() + 0.1*np.eye(3) r = m.as_matrix()
rot = Rotation.from_basis(om,False,reciprocal=reciprocal) r = np.linalg.inv(tensor.transpose(r)/np.pi) if reciprocal else r
assert np.isclose(np.linalg.det(rot.as_matrix()),1.0) o = Rotation.from_basis(r,
reciprocal=reciprocal)
f = Rotation(np.where(np.isclose(m.as_quaternion()[...,0],0.0,atol=atol)[...,np.newaxis],~o,o))
assert np.logical_or(m.isclose(o,atol=atol),
m.isclose(f,atol=atol)
).all()
@pytest.mark.parametrize('shape',[None,1,(4,4)]) @pytest.mark.parametrize('shape',[None,1,(4,4)])
def test_random(self,shape): def test_random(self,shape):
r = Rotation.from_random(shape) r = Rotation.from_random(shape)
if shape is None: assert r.shape == () if shape is None else (1,) if shape == 1 else shape
assert r.shape == ()
elif shape == 1:
assert r.shape == (1,)
else:
assert r.shape == shape
@pytest.mark.parametrize('shape',[None,5,(4,6)]) @pytest.mark.parametrize('shape',[None,5,(4,6)])
def test_equal(self,shape): def test_equal(self,shape):
@ -947,13 +997,13 @@ class TestRotation:
p = np.random.rand(n,3) p = np.random.rand(n,3)
o = Rotation._get_pyramid_order(p,direction) o = Rotation._get_pyramid_order(p,direction)
for i,o_i in enumerate(o): for i,o_i in enumerate(o):
assert np.all(o_i==Rotation._get_pyramid_order(p[i],direction)) assert (o_i==Rotation._get_pyramid_order(p[i],direction)).all()
def test_pyramid_invariant(self): def test_pyramid_invariant(self):
a = np.random.rand(n,3) a = np.random.rand(n,3)
f = Rotation._get_pyramid_order(a,'forward') f = Rotation._get_pyramid_order(a,'forward')
b = Rotation._get_pyramid_order(a,'backward') b = Rotation._get_pyramid_order(a,'backward')
assert np.all(np.take_along_axis(np.take_along_axis(a,f,-1),b,-1) == a) assert (np.take_along_axis(np.take_along_axis(a,f,-1),b,-1) == a).all()
@pytest.mark.parametrize('data',[np.random.rand(5,3), @pytest.mark.parametrize('data',[np.random.rand(5,3),

2
src/IO.f90
View File

@ -484,6 +484,8 @@ subroutine IO_error(error_ID,ext_msg,label1,ID1,label2,ID2)
! user errors ! user errors
case (602) case (602)
msg = 'invalid selection for debug' msg = 'invalid selection for debug'
case (603)
msg = 'invalid data for table'
!------------------------------------------------------------------------------------------------ !------------------------------------------------------------------------------------------------
! errors related to YAML data ! errors related to YAML data

1
src/Marc/DAMASK_Marc.f90
View File

@ -153,6 +153,7 @@ end module DAMASK_interface
#include "../math.f90" #include "../math.f90"
#include "../rotations.f90" #include "../rotations.f90"
#include "../polynomials.f90" #include "../polynomials.f90"
#include "../tables.f90"
#include "../lattice.f90" #include "../lattice.f90"
#include "element.f90" #include "element.f90"
#include "../geometry_plastic_nonlocal.f90" #include "../geometry_plastic_nonlocal.f90"

466
src/Marc/include/concom2022.3 vendored Normal file
View File

@ -0,0 +1,466 @@
! common block definition file taken from respective MSC.Marc release and reformated to free format
!***********************************************************************
!
! File: concom.cmn
!
! MSC.Marc include file
!
integer &
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,&
ipoist, irpflo, ismall, ismalt, isoil, ispect, ispnow, istore, iswep, ithcrp,&
itherm, iupblg, iupdat, jacflg, jel, jparks, largst, lfond, loadup, loaduq,&
lodcor, lovl, lsub, magnet, ncycle, newtnt, newton, noshr, linear, ivscpl,&
icrpim, iradrt, ipshft, itshr, iangin, iupmdr, iconjf, jincfl, jpermg, jhour,&
isolvr, jritz, jtable, jshell, jdoubl, jform, jcentr, imini, kautth, iautof,&
ibukty, iassum, icnstd, icnstt, kmakmas, imethvp, iradrte, iradrtp, iupdate, iupdatp,&
ncycnt, marmen , idynme, ihavca, ispf, kmini, imixex, largtt, kdoela, iautofg,&
ipshftp, idntrc, ipore, jtablm, jtablc, isnecma, itrnspo, imsdif, jtrnspo, mcnear,&
imech, imecht, ielcmat, ielectt, magnett, imsdift, noplas, jtabls, jactch, jtablth,&
kgmsto , jpzo, ifricsh, iremkin, iremfor, ishearp, jspf, machining, jlshell, icompsol,&
iupblgfo, jcondir, nstcrp, nactive, ipassref, nstspnt, ibeart, icheckmpc, noline, icuring,&
ishrink, ioffsflg, isetoff, ioffsetm,iharmt, inc_incdat, iautspc, ibrake, icbush, istream_input,&
iprsinp, ivlsinp, ifirst_time,ipin_m, jgnstr_glb, imarc_return,iqvcinp, nqvceid, istpnx, imicro1,&
iaxisymm, jbreakglue,iglstif, jfastasm,iwear, iwearcf, imixmeth, ielcmadyn, idinout, igena_meth,&
magf_meth, non_assumed, iredoboudry, ioffsz0,icomplt, mesh_dual, iactrp, mgnewton, iusedens,igsigd0,&
iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
icsprg, imol, imolt, idatafit,iharmpar, inclcase, imultifreq,init_elas, ifatig, iftgmat,&
nchybrid, ibuckle, iexpande
dimension :: ideva(60)
integer num_concom
parameter(num_concom=263)
common/marc_concom/&
iacous, iasmbl, iautth, ibear, icompl, iconj, icreep, ideva, idyn, idynt,&
ielas, ielcma, ielect, iform, ifour, iharm, ihcps, iheat, iheatt, ihresp,&
ijoule, ilem, ilnmom, iloren, inc, incext, incsub, ipass, iplres, ipois,&
ipoist, irpflo, ismall, ismalt, isoil, ispect, ispnow, istore, iswep, ithcrp,&
itherm, iupblg, iupdat, jacflg, jel, jparks, largst, lfond, loadup, loaduq,&
lodcor, lovl, lsub, magnet, ncycle, newtnt, newton, noshr, linear, ivscpl,&
icrpim, iradrt, ipshft, itshr, iangin, iupmdr, iconjf, jincfl, jpermg, jhour,&
isolvr, jritz, jtable, jshell, jdoubl, jform, jcentr, imini, kautth, iautof,&
ibukty, iassum, icnstd, icnstt, kmakmas, imethvp, iradrte, iradrtp, iupdate, iupdatp,&
ncycnt, marmen, idynme, ihavca, ispf, kmini, imixex, largtt, kdoela, iautofg,&
ipshftp, idntrc, ipore, jtablm, jtablc, isnecma, itrnspo, imsdif, jtrnspo, mcnear,&
imech, imecht, ielcmat, ielectt, magnett, imsdift, noplas, jtabls, jactch, jtablth,&
kgmsto , jpzo, ifricsh, iremkin, iremfor, ishearp, jspf, machining, jlshell, icompsol,&
iupblgfo, jcondir, nstcrp, nactive, ipassref, nstspnt, ibeart, icheckmpc, noline, icuring,&
ishrink, ioffsflg, isetoff, ioffsetm,iharmt, inc_incdat, iautspc, ibrake, icbush, istream_input,&
iprsinp, ivlsinp, ifirst_time,ipin_m, jgnstr_glb, imarc_return,iqvcinp, nqvceid, istpnx, imicro1,&
iaxisymm, jbreakglue,iglstif, jfastasm,iwear, iwearcf, imixmeth, ielcmadyn, idinout, igena_meth,&
magf_meth, non_assumed, iredoboudry, ioffsz0,icomplt, mesh_dual, iactrp, mgnewton, iusedens,igsigd0,&
iaem, icosim, inodels, nlharm, iampini, iphasetr, inonlcl, inonlct, iforminp,ispecerror,&
icsprg, imol, imolt, idatafit,iharmpar, inclcase, imultifreq,init_elas, ifatig, iftgmat,&
nchybrid, ibuckle, iexpande
!
! comments of variables:
!
! iacous Control flag for acoustic analysis. Input data.
! iacous=1 modal acoustic analysis.
! iacous=2 harmonic acoustic-structural analysis.
! iasmbl Control flag to indicate that operator matrix should be
! recalculated.
! iautth Control flag for AUTO THERM option.
! ibear Control flag for bearing analysis. Input data.
! icompl Control variable to indicate that a complex analysis is
! being performed. Either a Harmonic analysis with damping,
! or a harmonic electro-magnetic analysis. Input data.
! iconj Flag for EBE conjugate gradient solver (=solver 1, retired)
! Also used for VKI iterative solver.
! icreep Control flag for creep analysis. Input data.
! ideva(60) - debug print out flag
! 1 print element stiffness matrices, mass matrix
! 2 output matrices used in tying
! 3 force the solution of a nonpositive definite matrix
! 4 print info of connections to each node
! 5 info of gap convergence, internal heat generated, contact
! touching and separation
! 6 nodal value array during rezoning
! 7 tying info in CONRAD GAP option, fluid element numbers in
! CHANNEL option
! 8 output incremental displacements in local coord. system
! 9 latent heat output
! 10 stress-strain in local coord. system
! 11 additional info on interlaminar stress
! 12 output right hand side and solution vector
! 13 info of CPU resources used and memory available on NT
! 14 info of mesh adaption process, 2D outline information
! info of penetration checking for remeshing
! save .fem files after afmesh3d meshing
! print local adaptivity info
! 15 surface energy balance flag
! 16 print info regarding pyrolysis
! 17 print info of "streamline topology"
! 18 print mesh data changes after remeshing
! 19 print material flow stress data read in from *.mat file
! if unit flag is on, print out flow stress after conversion
! 20 print information on table input
! 21 print out information regarding kinematic boundary conditions
! 22 print out information regarding dist loads, point loads, film
! and foundations
! 23 print out information about automatic domain decomposition
! 24 print out iteration information in SuperForm status report file
! 25 print out information for ablation
! 26 print out information for films - Table input
! 27 print out the tying forces
! 28 print out for CASI solver, convection,
! 29 DDM single file debug printout
! 30 print out cavity debug info
! 31 print out welding related info
! 32 prints categorized DDM memory usage
! 33 print out the cutting info regarding machining feature
! 34 print out the list of quantities which can be defined via a table
! and for each quantity the supported independent variables
! 35 print out detailed coupling region info
! 36 print out solver debug info level 1 (Least Detailed)
! 37 print out solver debug info level 1 (Medium Detailed)
! 38 print out solver debug info level 1 (Very Detailed)
! 39 print detailed memory allocation info
! 40 print out marc-adams debug info
! 41 output rezone mapping post file for debugging
! 42 output post file after calling oprofos() for debugging
! 43 debug printout for vcct
! 44 debug printout for progressive failure
! 45 print out automatically generated midside node coordinates (arecrd)
! 46 print out message about routine and location, where the ibort is raised (ibort_inc)
! 47 print out summary message of element variables on a
! group-basis after all the automatic changes have been
! made (em_ellibp)
! 48 Automatically generate check results based on max and min vals.
! These vals are stored in the checkr file, which is inserted
! into the *dat file by the generate_check_results script from /marc/tools
! 49 Automatically generate check results based on the real calculated values
! at the sppecified check result locations.
! These vals are stored in the checkr file, which is inserted
! into the *dat file by the update_check_results script from /marc/tools
! 50 generate a file containing the resistance or capacity matrix;
! this file can be used to compare results with a reference file
! 51 print out detailed information for segment-to-segment contact
! 52 print out detailed relative displacement information
! for uniaxial sliding contact
! 53 print out detailed sliding direction information for
! uniaxial sliding contact
! 54 print out detailed information for edges attached to a curve
! 55 print information related to viscoelasticity calculations
! 56 print out detailed information for element coloring for multithreading
! 57 print out extra overheads due to multi-threading.
! These overhead includes (i) time and (ii) memory.
! The memory report will be summed over all the children.
! 58 debug output for ELSTO usage
! 59 print out contact body forces and nodes in contact
!
! idyn Control flag for dynamics. Input data.
! 1 = eigenvalue extraction and / or modal superposition
! 2 = Newmark Beta and Single Step Houbolt (ssh with idynme=1)
! 3 = Houbolt
! 4 = Central difference
! 5 = Newer central difference
! idynt Copy of idyn at begining of increment
! ielas Control flag for ELASTIC analysis. Input data.
! Set by user or automatically turned on by Fourier option.
! Implies that each load case is treated separately.
! In Adaptive meshing analysis , forces re-analysis until
! convergence obtained.
! Also seriously misused to indicate no convergence.
! = 1 elastic option with fourier analysis
! = 2 elastic option without fourier analysis
! =-1 no convergence in recycles or max # increments reached
! Set to 1 if ELASTIC or SUBSTRUC parameter cards are used,
! or if fourier option is used.
! Then set to 2 if not fourier analysis.
! ielcma Control flag for electromagnetic analysis. Input data.
! ielcma = 1 Harmonic formulation
! ielcma = 2 Transient formulation
! ielect Control flag for electrostatic option. Input data.
! iform Control flag indicating that contact will be performed.
! ifour Control flag for Fourier analysis.
! 0 = Odd and even terms.
! 1 = symmetric (cosine) terms
! 2 = antisymmetric (sine) terms.
! iharm Control flag to indicate that a harmonic analysis will
! be performed. May change between passes.
! ihcps Control flag for coupled thermal - stress analysis.
! iheat Control flag for heat transfer analysis. Input data.
! iheatt Permanent control flag for heat transfer analysis.
! Note in coupled analysis iheatt will remain as one,
! but iheat will be zero in stress pass.
! ihresp Control flag to indicate to perform a harmonic subincrement.
! ijoule Control flag for Joule heating.
! ilem Control flag to determin which vector is to be transformed.
! Control flag to see where one is:
! ilem = 1 - elem.f
! ilem = 2 - initst.f
! ilem = 3 - pressr.f
! ilem = 3 - fstif.f
! ilem = 4 - jflux.f
! ilem = 4 - strass.f
! ilem = 5 - mass.f
! ilem = 5 - osolty.f
! ilnmom Control flag for soil - pore pressure calculation. Input data.
! ilnmom = 0 - perform only pore pressure calculation.
! = 1 - couples pore pressure - displacement analysis
! iloren Control flag for DeLorenzi J-Integral evaluation. Input data.
! inc Increment number.
! incext Control flag indicating that currently working on a
! subincrement.
! Could be due to harmonics , damping component (bearing),
! stiffness component (bearing), auto therm creep or
! old viscoplaticity
! incsub Sub-increment number.
! inonlcl control flag for nonlocal pass
! inonlct permanent control flag for nonlocal pass
! ipass Control flag for which part of coupled analysis.
! ipass = -1 - reset to base values
! ipass = 0 - do nothing
! ipass = 1 - stress part
! ipass = 2 - heat transfer part
! 3 - fluid pass
! 4 - joule heating pass
! 5 - pore pressure pass
! 6 - electrostatic pass
! 7 - magnetostatic pass
! 8 - electromagnetic pass
! 9 - diffusion pass
! ipass = 10 - nonlocal part
! iplres Flag indicating that either second matrix is stored.
! dynamic analysis - mass matrix
! heat transfer - specific heat matrix
! buckle - initial stress stiffness
! ipois Control flag indicating Poisson type analysis
! ipois = 1 for heat transfer
! = 1 for heat transfer part of coupled
! = 1 for bearing
! = 1 for electrostatic
! = 1 for magnetostatic
! = 1 for nonlocal part
! ipoist Permanent copy of ipois. In coupled analysis , ipois = 0
! in stress portion, yet ipoist will still =1.
! irpflo global flag for rigid plastic flow analysis
! = 1 eularian formulation
! = 2 regular formulation; rigid material present in the analysis
! ismall control flag to indicate small displacement analysis. input data.
! ismall = 0 - large disp included.
! ismall = 1 - small displacement.
! the flag is changing between passes.
! ismalt permanent copy of ismall . in heat transfer portion of
! coupled analysis ismall =0 , but ismalt remains the same.
! isoil control flag indicating that soil / pore pressure
! calculation . input data.
! ispect control flag for response spectrum calculation. input data.
! ispnow control flag to indicate to perform a spectrum response
! calculation now.
! istore store stresses flag.
! istore = 0 in elem.f and if first pass of creep
! convergence checking in ogetst.f
! or harmonic analysis or thruc.f if not
! converged.
! iswep control flag for eigenvalue analysis.
! iswep=1 - go do extraction process
! ithcrp control flag for auto therm creep option. input data.
! itherm control flag for either temperature dependent material
! properties and/or thermal loads.
! iupblg control flag for follower force option. input data.
! iupdat control flag for update lagrange option for current element.
! jacflg control flag for lanczos iteration method. input data.
! jel control flag indicating that total load applied in
! increment, ignore previous solution.
! jel = 1 in increment 0
! = 1 if elastic or fourier
! = 1 in subincrements with elastic and adaptive
! jparks control flag for j integral by parks method. input data.
! largst control flag for finite strain plasticity. input data.
! lfond control variable that indicates if doing elastic
! foundation or film calculation. influences whether
! this is volumetric or surface integration.
! loadup control flag that indicates that nonlinearity occurred
! during previous increment.
! loaduq control flag that indicates that nonlinearity occurred.
! lodcor control flag for switching on the residual load correction.
! notice in input stage lodcor=0 means no loadcor,
! after omarc lodcor=1 means no loadcor
! lovl control flag for determining which "overlay" is to
! be called from ellib.
! lovl = 1 omarc
! = 2 oaread
! = 3 opress
! = 4 oasemb
! = 5 osolty
! = 6 ogetst
! = 7 oscinc
! = 8 odynam
! = 9 opmesh
! = 10 omesh2
! = 11 osetz
! = 12 oass
! = 13 oincdt
! = 14 oasmas
! = 15 ofluas
! = 16 ofluso
! = 17 oshtra
! = 18 ocass
! = 19 osoltc
! = 20 orezon
! = 21 otest
! = 22 oeigen
! lsub control variable to determine which part of element
! assembly function is being done.
! lsub = 1 - no longer used
! = 2 - beta*
! = 3 - cons*
! = 4 - ldef*
! = 5 - posw*
! = 6 - theta*
! = 7 - tmarx*
! = 8 - geom*
! magnet control flag for magnetostatic analysis. input data.
! ncycle cycle number. accumulated in osolty.f
! note first time through oasemb.f , ncycle = 0.
! newtnt control flag for permanent copy of newton.
! newton iteration type. input data.
! newton : = 1 full newton raphson
! 2 modified newton raphson
! 3 newton raphson with strain correct.
! 4 direct substitution
! 5 direct substitution followed by n.r.
! 6 direct substitution with line search
! 7 full newton raphson with secant initial stress
! 8 secant method
! 9 full newton raphson with line search
! noshr control flag for calculation interlaminar shears for
! elements 22,45, and 75. input data.
!ees
!
! jactch = 1 or 2 if elements are activated or deactivated
! = 3 if elements are adaptively remeshed or rezoned
! = 0 normally / reset to 0 when assembly is done
! ifricsh = 0 call to fricsh in otest not needed
! = 1 call to fricsh (nodal friction) in otest needed
! iremkin = 0 remove deactivated kinematic boundary conditions
! immediately - only in new input format (this is default)
! = 1 remove deactivated kinematic boundary conditions
! gradually - only in new input format
! iremfor = 0 remove force boundary conditions immediately -
! only in new input format (this is default)
! = 1 remove force boundary conditions gradually -
! only in new input format (this is default)
! ishearp set to 1 if shear panel elements are present in the model
!
! jspf = 0 not in spf loadcase
! > 0 in spf loadcase (jspf=1 during first increment)
! machining = 1 if the metal cutting feature is used, for memory allocation purpose
! = 0 (default) if no metal cutting feature required
!
! jlshell = 1 if there is a shell element in the mesh
! icompsol = 1 if there is a composite solid element in the mesh
! iupblgfo = 1 if follower force for point loads
! jcondir = 1 if contact priority option is used
! nstcrp = 0 (default) steady state creep flag (undocumented feature.
! if not 0, turns off special ncycle = 0 code in radial.f)
! nactive = number of active passes, if =1 then it's not a coupled analysis
! ipassref = reference ipass, if not in a multiphysics pass ipass=ipassref
! icheckmpc = value of mpc-check parameter option
! noline = set to 1 in osolty if no line seacrh should be done in ogetst
! icuring = set to 1 if the curing is included for the heat transfer analysis.
! ishrink = set to 1 if shrinkage strain is included for mechancial analysis.
! ioffsflg = 1 for small displacement beam/shell offsets
! = 2 for large displacement beam/shell offsets
! isetoff = 0 - do not apply beam/shell offsets
! = 1 - apply beam/shell offsets
! ioffsetm = min. value of offset flag
! iharmt = 1 global flag if a coupled analysis contains an harmonic pass
! inc_incdat = flag to record increment number of a new loadcase in incdat.f
! iautspc = flag for AutoSPC option
! ibrake = brake squeal in this increment
! icbush = set to 1 if cbush elements present in model
! istream_input = set to 1 for streaming input calling Marc as library
! iprsinp = set to 1 if pressure input, introduced so other variables
! such as h could be a function of pressure
! ivlsinp = set to 1 if velocity input, introduced so other variables
! such as h could be a function of velocity
! ipin_m = # of beam element with PIN flag
! jgnstr_glb = global control over pre or fast integrated composite shells
! imarc_return = Marc return flag for streaming input control
! iqvcimp = if non-zero, then the number of QVECT boundary conditions
! nqvceid = number of QVECT boundary conditions, where emisivity/absorbtion id entered
! istpnx = 1 if to stop at end of increment
! imicro1 = 1 if micro1 interface is used
! iaxisymm = set to 1 if axisymmetric analysis
! jbreakglue = set to 1 if breaking glued option is used
! iglstif = 1 if ddm and global stiffness matrix formed (sgi solver 6 or solver9)
! jfastasm = 1 do fast assembly using SuperForm code
! iwear = set to 1 if wear model, set to 2 if wear model and coordinates updated
! iwearcf = set to 1 to store nodal coefficient of friction for wear calculation
! imixmeth = set=1 then use nonlinear mixture material - allocate memory
! ielcmadyn = flag for magnetodynamics
! 0 - electromagnetics using newmark beta
! 1 - transient magnetics using backward euler
! idinout = flag to control if inside out elements should be deactivated
! igena_meth = 0 - generalized alpha parameters depend on whether or not contact
! is flagged (dynamic,7)
! 10 - generalized alpha parameters are optimized for a contact
! analysis (dynamic,8)
! 11 - generalized alpha parameters are optimized for an analysis
! without contact (dynamic,8)
! magf_meth = - Method to compute force in magnetostatic - structural
! = 1 - Virtual work method based on finite difference for the force computation
! = 2 - Maxwell stress tensor
! = 3 - Virtual work method based on local derivative for the force computation
! non_assumed = 1 no assumed strain formulation (forced)
! iredoboudry set to 1 if contact boundary needs to be recalculated
! ioffsz0 = 1 if composite are used with reference position.ne.0
! icomplt = 1 global flag if a coupled analysis contains an complex pass
! mesh_dual = 1 two independent meshes are used in magnetodynamic/thermal/structural
! one for magnetodynamic and the other for the remaining passes
! iactrp = 1 in an analysis with global remeshing, include inactive
! rigid bodies on post file
! mgnewton = 1 Use full Newton Raphson iteration for magnetostatic pass
!
! iusedens > 0 if mass density is used in the analysis (dynamics, mass dependent loading)
! igsigd0 = 1 set varselem(igsigd) to zero in next oasemb
! iaem = 1 if marc is called from aem (0 - off - default)
! icosim = 1 if marc is used in co-simulation analysis with ADAMS using the CosimEngine
! = 2 if marc is used in co-simulation analysis with ADAMS using the ACSI interface
! = 3 if marc is used in co-simulation analysis with scFLOW using the CosimEngine
! = 4 if marc is used in co-simulation analysis with scFLOW and ADAMS using the CosimEngine
! inodels = 1 nodal integration elements 239/240/241 present
! nlharm = 0 harmonic subincrements are linear
! = 1 harmonic subincrements are nonlinear
! iampini = 0 amplitude of previous harmonic subinc is initial estimate (default)
! = 1 zero amplitude is initial estimate
! iphasetr = 1 phase transformation material model is used
! iforminp flag indicating that contact is switched on via the CONTACT
! option in the input file (as opposed to the case that contact
! is switched on internally due to cyclic symmetry or model
! section creation)
! ispecerror = a+10*b (only for spectrum response analysis with missing mass option)
! a=0 or a=1 (modal shape with non-zero shift)
! b=0 or b=1 (recover with new assembly of stiffness matrix)
! icsprg = set to 1 if spring elements present in model
! imol Control flag for molecualr diffusion pass
! imolt Permanent control flag for molecualr diffusion pass
! Note in coupled analysis imolt will remain as one,
! but imol will be zero in stress pass or thermal pass.
! idatafit = run Marc to fit parameters
! iharmpar = 1 if harmonic parameter option is used
! inclcase load case increment use for cyclic plasticity data fitting
! imultifreq flag to indicate how many harmonic magnetodynamic passes are computed in coupled
! magnetodynamic/thermal(/structural) analyses.
! 0 or 1 one pass 2 two passes 3 or more is not supported
! init_elas use elastic stress-strain law as the material tangent for
! the first cycle of an increment
! ifatig packed integer telling which fatigue mode is active
! 1 = elastomer
! 10 = stress-life
! 100 = strain-life
! = 2 strain-life fatigue
! iftgmat = 0 no fatigue material properties in the dat file
! = 1 fatigue material properties in the dat file
! nchybrid cycle count used for hybrid contact; meant to force an extra iteration
! if the overlap for a node in hybrid contact is too large
! ibuckle buckle parameter option is active
! iexpande set to 1 if expanded elements (248, 249, 250 or 251) are
! present, 0 otherwise
!
!***********************************************************************
!$omp threadprivate(/marc_concom/)
!!

73
src/Marc/include/creeps2022.3 vendored Normal file
View File

@ -0,0 +1,73 @@
! common block definition file taken from respective MSC.Marc release and reformated to free format
!***********************************************************************
!
! File: creeps.cmn
!
! MSC.Marc include file
!
real(pReal) cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b
integer icfte,icfst,icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,&
icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
real(pReal) time_beg_lcase,time_beg_inc,fractol,time_beg_pst
real(pReal) fraction_donn,timinc_ol2
!
integer num_creepsr,num_creepsi,num_creeps2r,ncrp_arry
parameter(num_creepsr=7)
parameter(num_creepsi=17)
parameter(num_creeps2r=6)
parameter(ncrp_arry=7)
common/marc_creeps/cptim,timinc,timinc_p,timinc_s,timincm,timinc_a,timinc_b,icfte,icfst,&
icfeq,icftm,icetem,mcreep,jcreep,icpa,icftmp,icfstr,icfqcp,icfcpm,icrppr,icrcha,icpb,iicpmt,iicpa
common/marc_creeps2/time_beg_lcase,time_beg_inc,fractol,time_beg_pst,fraction_donn,timinc_ol2
!
! cptim Total time at begining of increment.
! timinc Incremental time for this step.
! icfte Local copy number of slopes of creep strain rate function
! versus temperature. Is -1 if exponent law used.
! icfst Local copy number of slopes of creep strain rate function
! versus equivalent stress. Is -1 if exponent law used.
! icfeq Local copy number of slopes of creep strain rate function
! versus equivalent strain. Is -1 if exponent law used.
! icftm Local copy number of slopes of creep strain rate function
! versus time. Is -1 if exponent law used.
! icetem Element number that needs to be checked for creep convergence
! or, if negative, the number of elements that need to
! be checked. In the latter case the elements to check
! are stored in ielcp.
! mcreep Maximum nuber of iterations for explicit creep.
! jcreep Counter of number of iterations for explicit creep
! procedure. jcreep must be .le. mcreep
! icpa(1-6) Pointer to constants in creep strain rate expression.
! icftmp Pointer to temperature dependent creep strain rate data.
! icfstr Pointer to equivalent stress dependent creep strain rate data.
! icfqcp Pointer to equivalent creep strain dependent creep strain
! rate data.
! icfcpm Pointer to equivalent creep strain rate dependent
! creep strain rate data.
! icrppr Permanent copy of icreep
! icrcha Control flag for creep convergence checking , if set to
! 1 then testing on absolute change in stress and creep
! strain, not relative testing. Input data.
! icpb(1-4) Pointer to storage of material id cross reference numbers.
! iicpmt creep law type ID
! =1 - power law
! =2 - solder
! =3 - steady-creep
! =4 - hyperbolic steady-creep
! iicpa Pointer to table IDs for constants in creep strain rate
! expression
!
!
! time_beg_lcase time at the beginning of the current load case
! time_beg_inc time at the beginning of the current increment
! fractol fraction of loadcase or increment time when we
! consider it to be finished
! time_beg_pst time corresponding to first increment to be
! read in from thermal post file for auto step
!
! timinc_old Time step of the previous increment
!
!***********************************************************************
!!$omp threadprivate(/marc_creeps/)
!!$omp threadprivate(/marc_creeps2/)
!!

38
src/Marc/materialpoint_Marc.f90
View File

@ -15,6 +15,7 @@ module materialpoint_Marc
use math use math
use rotations use rotations
use polynomials use polynomials
use tables
use lattice use lattice
use material use material
use phase use phase
@ -72,26 +73,27 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Initialize all modules. !> @brief Initialize all modules.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine materialpoint_initAll subroutine materialpoint_initAll()
call DAMASK_interface_init call DAMASK_interface_init()
call prec_init call prec_init()
call IO_init call IO_init()
call YAML_types_init call YAML_types_init()
call YAML_parse_init call YAML_parse_init()
call HDF5_utilities_init call HDF5_utilities_init()
call results_init(.false.) call results_init(.false.)
call config_init call config_init()
call math_init call math_init()
call rotations_init call rotations_init()
call polynomials_init call polynomials_init()
call lattice_init call tables_init()
call discretization_Marc_init call lattice_init()
call discretization_Marc_init()
call material_init(.false.) call material_init(.false.)
call phase_init call phase_init()
call homogenization_init call homogenization_init()
call materialpoint_init call materialpoint_init()
call config_deallocate call config_deallocate()
end subroutine materialpoint_initAll end subroutine materialpoint_initAll
@ -99,7 +101,7 @@ end subroutine materialpoint_initAll
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief allocate the arrays defined in module materialpoint and initialize them !> @brief allocate the arrays defined in module materialpoint and initialize them
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine materialpoint_init subroutine materialpoint_init()
type(tList), pointer :: & type(tList), pointer :: &
debug_materialpoint debug_materialpoint

26
src/YAML_parse.f90
View File

@ -55,6 +55,7 @@ end subroutine YAML_parse_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Parse a YAML string with list as root into a a structure of nodes. !> @brief Parse a YAML string with list as root into a a structure of nodes.
!> @details The string needs to end with a newline (unless using libfyaml).
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function YAML_parse_str_asList(str) result(list) function YAML_parse_str_asList(str) result(list)
@ -72,6 +73,7 @@ end function YAML_parse_str_asList
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Parse a YAML string with dict as root into a a structure of nodes. !> @brief Parse a YAML string with dict as root into a a structure of nodes.
!> @details The string needs to end with a newline (unless using libfyaml).
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function YAML_parse_str_asDict(str) result(dict) function YAML_parse_str_asDict(str) result(dict)
@ -764,7 +766,7 @@ end subroutine dct
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! @brief decide whether next block is list or dict ! @brief Decide whether next block is list or dict.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
recursive subroutine decide(blck,flow,s_blck,s_flow,offset) recursive subroutine decide(blck,flow,s_blck,s_flow,offset)
@ -811,11 +813,12 @@ recursive subroutine decide(blck,flow,s_blck,s_flow,offset)
end if end if
end if end if
end subroutine end subroutine decide
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
! @brief Convert all block style YAML parts to flow style. !> @brief Convert all block style YAML parts to flow style.
!> @details The input needs to end with a newline.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function to_flow(blck) function to_flow(blck)
@ -852,7 +855,7 @@ end function to_flow
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Check correctness of some YAML functions. !> @brief Check correctness of some YAML functions.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine selfTest subroutine selfTest()
if (indentDepth(' a') /= 1) error stop 'indentDepth' if (indentDepth(' a') /= 1) error stop 'indentDepth'
if (indentDepth('a') /= 0) error stop 'indentDepth' if (indentDepth('a') /= 0) error stop 'indentDepth'
@ -998,6 +1001,21 @@ subroutine selfTest
if (.not. to_flow(block_flow) == mixed_flow) error stop 'to_flow' if (.not. to_flow(block_flow) == mixed_flow) error stop 'to_flow'
end block basic_mixed end block basic_mixed
parse: block
type(tDict), pointer :: dict
type(tList), pointer :: list
character(len=*), parameter :: &
lst = '[1, 2, 3, 4]', &
dct = '{a: 1, b: 2}'
list => YAML_parse_str_asList(lst//IO_EOL)
if (list%asFormattedString() /= lst) error stop 'str_asList'
dict => YAML_parse_str_asDict(dct//IO_EOL)
if (dict%asFormattedString() /= dct) error stop 'str_asDict'
end block parse
end subroutine selfTest end subroutine selfTest
#endif #endif

4
src/grid/DAMASK_grid.f90
View File

@ -482,6 +482,8 @@ program DAMASK_grid
call mechanical_restartWrite call mechanical_restartWrite
case(FIELD_THERMAL_ID) case(FIELD_THERMAL_ID)
call grid_thermal_spectral_restartWrite call grid_thermal_spectral_restartWrite
case(FIELD_DAMAGE_ID)
call grid_damage_spectral_restartWrite
end select end select
end do end do
call materialpoint_restartWrite call materialpoint_restartWrite
@ -526,6 +528,6 @@ subroutine getMaskedTensor(values,mask,tensor)
end do end do
end do end do
end subroutine end subroutine getMaskedTensor
end program DAMASK_grid end program DAMASK_grid

4
src/grid/VTI.f90
View File

@ -222,7 +222,7 @@ subroutine cellsSizeOrigin(c,s,o,header)
temp = getXMLValue(header,'Origin') temp = getXMLValue(header,'Origin')
o = [(IO_floatValue(temp,IO_stringPos(temp),i),i=1,3)] o = [(IO_floatValue(temp,IO_stringPos(temp),i),i=1,3)]
end subroutine end subroutine cellsSizeOrigin
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -421,7 +421,7 @@ pure function getXMLValue(line,key)
end if end if
end if end if
end function end function getXMLValue
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------

51
src/grid/grid_damage_spectral.f90
View File

@ -16,6 +16,9 @@ module grid_damage_spectral
use prec use prec
use parallelization use parallelization
use IO use IO
use CLI
use HDF5_utilities
use HDF5
use spectral_utilities use spectral_utilities
use discretization_grid use discretization_grid
use homogenization use homogenization
@ -59,13 +62,13 @@ module grid_damage_spectral
public :: & public :: &
grid_damage_spectral_init, & grid_damage_spectral_init, &
grid_damage_spectral_solution, & grid_damage_spectral_solution, &
grid_damage_spectral_restartWrite, &
grid_damage_spectral_forward grid_damage_spectral_forward
contains contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief allocates all neccessary fields and fills them with data !> @brief allocates all neccessary fields and fills them with data
! ToDo: Restart not implemented
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_init() subroutine grid_damage_spectral_init()
@ -76,6 +79,8 @@ subroutine grid_damage_spectral_init()
Vec :: uBound, lBound Vec :: uBound, lBound
integer(MPI_INTEGER_KIND) :: err_MPI integer(MPI_INTEGER_KIND) :: err_MPI
PetscErrorCode :: err_PETSc PetscErrorCode :: err_PETSc
integer(HID_T) :: fileHandle, groupHandle
real(pReal), dimension(1,product(cells(1:2))*cells3) :: tempN
type(tDict), pointer :: & type(tDict), pointer :: &
num_grid, & num_grid, &
num_generic num_generic
@ -167,6 +172,18 @@ subroutine grid_damage_spectral_init()
CHKERRQ(err_PETSc) CHKERRQ(err_PETSc)
end if end if
restartRead: if (CLI_restartInc > 0) then
print'(/,1x,a,i0,a)', 'reading restart data of increment ', CLI_restartInc, ' from file'
fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','r')
groupHandle = HDF5_openGroup(fileHandle,'solver')
call HDF5_read(tempN,groupHandle,'phi',.false.)
phi = reshape(tempN,[cells(1),cells(2),cells3])
call HDF5_read(tempN,groupHandle,'phi_lastInc',.false.)
phi_lastInc = reshape(tempN,[cells(1),cells(2),cells3])
end if restartRead
ce = 0 ce = 0
do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1) do k = 1, cells3; do j = 1, cells(2); do i = 1, cells(1)
ce = ce + 1 ce = ce + 1
@ -285,6 +302,36 @@ subroutine grid_damage_spectral_forward(cutBack)
end subroutine grid_damage_spectral_forward end subroutine grid_damage_spectral_forward
!--------------------------------------------------------------------------------------------------
!> @brief Write current solver and constitutive data for restart to file.
!--------------------------------------------------------------------------------------------------
subroutine grid_damage_spectral_restartWrite
PetscErrorCode :: err_PETSc
DM :: dm_local
integer(HID_T) :: fileHandle, groupHandle
PetscScalar, dimension(:,:,:), pointer :: phi
call SNESGetDM(SNES_damage,dm_local,err_PETSc);
CHKERRQ(err_PETSc)
call DMDAVecGetArrayF90(dm_local,solution_vec,phi,err_PETSc);
CHKERRQ(err_PETSc)
print'(1x,a)', 'writing damage solver data required for restart to file'; flush(IO_STDOUT)
fileHandle = HDF5_openFile(getSolverJobName()//'_restart.hdf5','a')
groupHandle = HDF5_openGroup(fileHandle,'solver')
call HDF5_write(reshape(phi,[1,product(cells(1:2))*cells3]),groupHandle,'phi')
call HDF5_write(reshape(phi_lastInc,[1,product(cells(1:2))*cells3]),groupHandle,'phi_lastInc')
call HDF5_closeGroup(groupHandle)
call HDF5_closeFile(fileHandle)
call DMDAVecRestoreArrayF90(dm_local,solution_vec,phi,err_PETSc);
CHKERRQ(err_PETSc)
end subroutine grid_damage_spectral_restartWrite
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Construct the residual vector. !> @brief Construct the residual vector.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -327,7 +374,7 @@ end subroutine formResidual
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief update reference viscosity and conductivity !> @brief Update reference viscosity and conductivity.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine updateReference() subroutine updateReference()

6
src/grid/grid_thermal_spectral.f90
View File

@ -281,7 +281,7 @@ end subroutine grid_thermal_spectral_forward
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Write current solver and constitutive data for restart to file !> @brief Write current solver and constitutive data for restart to file.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine grid_thermal_spectral_restartWrite subroutine grid_thermal_spectral_restartWrite
@ -313,7 +313,7 @@ end subroutine grid_thermal_spectral_restartWrite
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief forms the spectral thermal residual vector !> @brief Construct the residual vector.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc) subroutine formResidual(residual_subdomain,x_scal,r,dummy,err_PETSc)
@ -354,7 +354,7 @@ end subroutine formResidual
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief update reference viscosity and conductivity !> @brief Update reference viscosity and conductivity.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine updateReference() subroutine updateReference()

121
src/grid/spectral_utilities.f90
View File

@ -120,8 +120,8 @@ module spectral_utilities
utilities_GreenConvolution, & utilities_GreenConvolution, &
utilities_divergenceRMS, & utilities_divergenceRMS, &
utilities_curlRMS, & utilities_curlRMS, &
utilities_ScalarGradient, & utilities_scalarGradient, &
utilities_VectorDivergence, & utilities_vectorDivergence, &
utilities_maskedCompliance, & utilities_maskedCompliance, &
utilities_constitutiveResponse, & utilities_constitutiveResponse, &
utilities_calculateRate, & utilities_calculateRate, &
@ -577,9 +577,6 @@ real(pReal) function utilities_divergenceRMS(tensorField)
complex(pReal), dimension(3) :: rescaledGeom complex(pReal), dimension(3) :: rescaledGeom
print'(/,1x,a)', '... calculating divergence ................................................'
flush(IO_STDOUT)
tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
tensorField_real(1:3,1:3,1:cells(1), 1:cells(2),1:cells3) = tensorField tensorField_real(1:3,1:3,1:cells(1), 1:cells(2),1:cells3) = tensorField
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier) call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
@ -628,9 +625,6 @@ real(pReal) function utilities_curlRMS(tensorField)
complex(pReal), dimension(3) :: rescaledGeom complex(pReal), dimension(3) :: rescaledGeom
print'(/,1x,a)', '... calculating curl ......................................................'
flush(IO_STDOUT)
tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,1:cells(2),1:cells3) = 0.0_pReal
tensorField_real(1:3,1:3,1:cells(1), 1:cells(2),1:cells3) = tensorField tensorField_real(1:3,1:3,1:cells(1), 1:cells(2),1:cells3) = tensorField
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier) call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
@ -757,7 +751,7 @@ end function utilities_maskedCompliance
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Calculate gradient of scalar field. !> @brief Calculate gradient of scalar field.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function utilities_ScalarGradient(field) result(grad) function utilities_scalarGradient(field) result(grad)
real(pReal), intent(in), dimension( cells(1),cells(2),cells3) :: field real(pReal), intent(in), dimension( cells(1),cells(2),cells3) :: field
real(pReal), dimension(3,cells(1),cells(2),cells3) :: grad real(pReal), dimension(3,cells(1),cells(2),cells3) :: grad
@ -769,18 +763,18 @@ function utilities_ScalarGradient(field) result(grad)
scalarField_real(1:cells(1), 1:cells(2),1:cells3) = field scalarField_real(1:cells(1), 1:cells(2),1:cells3) = field
call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier) call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
do j = 1, cells2; do k = 1, cells(3); do i = 1,cells1Red do j = 1, cells2; do k = 1, cells(3); do i = 1,cells1Red
vectorField_fourier(1:3,i,k,j) = scalarField_fourier(i,k,j)*xi1st(1:3,i,k,j) ! ToDo: no -conjg? vectorField_fourier(1:3,i,k,j) = scalarField_fourier(i,k,j)*xi1st(1:3,i,k,j)
end do; end do; end do end do; end do; end do
call fftw_mpi_execute_dft_c2r(planVectorBack,vectorField_fourier,vectorField_real) call fftw_mpi_execute_dft_c2r(planVectorBack,vectorField_fourier,vectorField_real)
grad = vectorField_real(1:3,1:cells(1),1:cells(2),1:cells3)*wgt grad = vectorField_real(1:3,1:cells(1),1:cells(2),1:cells3)*wgt
end function utilities_ScalarGradient end function utilities_scalarGradient
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Calculate divergence of vector field. !> @brief Calculate divergence of vector field.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function utilities_VectorDivergence(field) result(div) function utilities_vectorDivergence(field) result(div)
real(pReal), intent(in), dimension(3,cells(1),cells(2),cells3) :: field real(pReal), intent(in), dimension(3,cells(1),cells(2),cells3) :: field
real(pReal), dimension( cells(1),cells(2),cells3) :: div real(pReal), dimension( cells(1),cells(2),cells3) :: div
@ -790,11 +784,11 @@ function utilities_VectorDivergence(field) result(div)
vectorField_real(1:3,1:cells(1), 1:cells(2),1:cells3) = field vectorField_real(1:3,1:cells(1), 1:cells(2),1:cells3) = field
call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier) call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier)
scalarField_fourier(1:cells1Red,1:cells(3),1:cells2) = sum(vectorField_fourier(1:3,1:cells1Red,1:cells(3),1:cells2) & scalarField_fourier(1:cells1Red,1:cells(3),1:cells2) = sum(vectorField_fourier(1:3,1:cells1Red,1:cells(3),1:cells2) &
*conjg(-xi1st),1) *conjg(-xi1st),1) ! ToDo: use "xi1st" instead of "conjg(-xi1st)"?
call fftw_mpi_execute_dft_c2r(planScalarBack,scalarField_fourier,scalarField_real) call fftw_mpi_execute_dft_c2r(planScalarBack,scalarField_fourier,scalarField_real)
div = scalarField_real(1:cells(1),1:cells(2),1:cells3)*wgt div = scalarField_real(1:cells(1),1:cells(2),1:cells3)*wgt
end function utilities_VectorDivergence end function utilities_vectorDivergence
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -936,7 +930,7 @@ end function utilities_forwardField
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief calculates filter for fourier convolution depending on type given in numerics.config !> @brief Calculate Filter for Fourier convolution.
!> @details this is the full operator to calculate derivatives, i.e. 2 \pi i k for the !> @details this is the full operator to calculate derivatives, i.e. 2 \pi i k for the
! standard approach ! standard approach
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -1133,43 +1127,116 @@ subroutine selfTest()
real(pReal), allocatable, dimension(:,:,:,:,:) :: tensorField_real_ real(pReal), allocatable, dimension(:,:,:,:,:) :: tensorField_real_
real(pReal), allocatable, dimension(:,:,:,:) :: vectorField_real_ real(pReal), allocatable, dimension(:,:,:,:) :: vectorField_real_
real(pReal), allocatable, dimension(:,:,:) :: scalarField_real_ real(pReal), allocatable, dimension(:,:,:) :: scalarField_real_
real(pReal), dimension(3,3) :: tensorSum
real(pReal), dimension(3) :: vectorSum
real(pReal) :: scalarSum
real(pReal), dimension(3,3) :: r
integer(MPI_INTEGER_KIND) :: err_MPI
call random_number(tensorField_real) call random_number(tensorField_real)
tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
tensorField_real_ = tensorField_real tensorField_real_ = tensorField_real
call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier) call fftw_mpi_execute_dft_r2c(planTensorForth,tensorField_real,tensorField_fourier)
if (worldsize==1) then call MPI_Allreduce(sum(sum(sum(tensorField_real_,dim=5),dim=4),dim=3),tensorSum,9_MPI_INTEGER_KIND, &
if (any(dNeq(sum(sum(sum(tensorField_real_,dim=5),dim=4),dim=3)/tensorField_fourier(:,:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) & MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
error stop 'tensorField avg' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (worldrank==0) then
if (any(dNeq(tensorSum/tensorField_fourier(:,:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) &
error stop 'mismatch avg tensorField FFT <-> real'
end if end if
call fftw_mpi_execute_dft_c2r(planTensorBack,tensorField_fourier,tensorField_real) call fftw_mpi_execute_dft_c2r(planTensorBack,tensorField_fourier,tensorField_real)
tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal tensorField_real(1:3,1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
if (maxval(abs(tensorField_real_ - tensorField_real*wgt))>5.0e-15_pReal) error stop 'tensorField' if (maxval(abs(tensorField_real_ - tensorField_real*wgt))>5.0e-15_pReal) &
error stop 'mismatch tensorField FFT/invFFT <-> real'
call random_number(vectorField_real) call random_number(vectorField_real)
vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
vectorField_real_ = vectorField_real vectorField_real_ = vectorField_real
call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier) call fftw_mpi_execute_dft_r2c(planVectorForth,vectorField_real,vectorField_fourier)
if (worldsize==1) then call MPI_Allreduce(sum(sum(sum(vectorField_real_,dim=4),dim=3),dim=2),vectorSum,3_MPI_INTEGER_KIND, &
if (any(dNeq(sum(sum(sum(vectorField_real_,dim=4),dim=3),dim=2)/vectorField_fourier(:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) & MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
error stop 'vector avg' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (worldrank==0) then
if (any(dNeq(vectorSum/vectorField_fourier(:,1,1,1)%re,1.0_pReal,1.0e-12_pReal))) &
error stop 'mismatch avg vectorField FFT <-> real'
end if end if
call fftw_mpi_execute_dft_c2r(planVectorBack,vectorField_fourier,vectorField_real) call fftw_mpi_execute_dft_c2r(planVectorBack,vectorField_fourier,vectorField_real)
vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal vectorField_real(1:3,cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
if (maxval(abs(vectorField_real_ - vectorField_real*wgt))>5.0e-15_pReal) error stop 'vectorField' if (maxval(abs(vectorField_real_ - vectorField_real*wgt))>5.0e-15_pReal) &
error stop 'mismatch vectorField FFT/invFFT <-> real'
call random_number(scalarField_real) call random_number(scalarField_real)
scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
scalarField_real_ = scalarField_real scalarField_real_ = scalarField_real
call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier) call fftw_mpi_execute_dft_r2c(planScalarForth,scalarField_real,scalarField_fourier)
if (worldsize==1) then call MPI_Allreduce(sum(sum(sum(scalarField_real_,dim=3),dim=2),dim=1),scalarSum,1_MPI_INTEGER_KIND, &
if (dNeq(sum(sum(sum(scalarField_real_,dim=3),dim=2),dim=1)/scalarField_fourier(1,1,1)%re,1.0_pReal,1.0e-12_pReal)) & MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,err_MPI)
error stop 'scalar avg' if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
if (worldrank==0) then
if (dNeq(scalarSum/scalarField_fourier(1,1,1)%re,1.0_pReal,1.0e-12_pReal)) &
error stop 'mismatch avg scalarField FFT <-> real'
end if end if
call fftw_mpi_execute_dft_c2r(planScalarBack,scalarField_fourier,scalarField_real) call fftw_mpi_execute_dft_c2r(planScalarBack,scalarField_fourier,scalarField_real)
scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal scalarField_real(cells(1)+1:cells1Red*2,:,:) = 0.0_pReal
if (maxval(abs(scalarField_real_ - scalarField_real*wgt))>5.0e-15_pReal) error stop 'scalarField' if (maxval(abs(scalarField_real_ - scalarField_real*wgt))>5.0e-15_pReal) &
error stop 'mismatch scalarField FFT/invFFT <-> real'
call random_number(r)
call MPI_Bcast(r,9_MPI_INTEGER_KIND,MPI_DOUBLE,0_MPI_INTEGER_KIND,MPI_COMM_WORLD,err_MPI)
if (err_MPI /= 0_MPI_INTEGER_KIND) error stop 'MPI error'
scalarField_real_ = r(1,1)
if (maxval(abs(utilities_scalarGradient(scalarField_real_)))>5.0e-9_pReal) error stop 'non-zero grad(const)'
vectorField_real_ = spread(spread(spread(r(1,:),2,cells(1)),3,cells(2)),4,cells3)
if (maxval(abs(utilities_vectorDivergence(vectorField_real_)))>5.0e-9_pReal) error stop 'non-zero div(const)'
tensorField_real_ = spread(spread(spread(r,3,cells(1)),4,cells(2)),5,cells3)
if (utilities_divergenceRMS(tensorField_real_)>5.0e-14_pReal) error stop 'non-zero RMS div(const)'
if (utilities_curlRMS(tensorField_real_)>5.0e-14_pReal) error stop 'non-zero RMS curl(const)'
if (cells(1) > 2 .and. spectral_derivative_ID == DERIVATIVE_CONTINUOUS_ID) then
scalarField_real_ = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
vectorField_real_ = utilities_scalarGradient(scalarField_real_)/TAU*geomSize(1)
scalarField_real_ = -spread(spread(planeSine (cells(1)),2,cells(2)),3,cells3)
if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-14_pReal) error stop 'grad cosine'
scalarField_real_ = spread(spread(planeSine (cells(1)),2,cells(2)),3,cells3)
vectorField_real_ = utilities_scalarGradient(scalarField_real_)/TAU*geomSize(1)
scalarField_real_ = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-14_pReal) error stop 'grad sine'
vectorField_real_(2:3,:,:,:) = 0.0_pReal
vectorField_real_(1,:,:,:) = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
scalarField_real_ = utilities_vectorDivergence(vectorField_real_)/TAU*geomSize(1)
vectorField_real_(1,:,:,:) =-spread(spread(planeSine( cells(1)),2,cells(2)),3,cells3)
if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-14_pReal) error stop 'div cosine'
vectorField_real_(2:3,:,:,:) = 0.0_pReal
vectorField_real_(1,:,:,:) = spread(spread(planeSine( cells(1)),2,cells(2)),3,cells3)
scalarField_real_ = utilities_vectorDivergence(vectorField_real_)/TAU*geomSize(1)
vectorField_real_(1,:,:,:) = spread(spread(planeCosine(cells(1)),2,cells(2)),3,cells3)
if (maxval(abs(vectorField_real_(1,:,:,:) - scalarField_real_))>5.0e-14_pReal) error stop 'div sine'
end if
contains
function planeCosine(n)
integer, intent(in) :: n
real(pReal), dimension(n) :: planeCosine
planeCosine = cos(real(math_range(n),pReal)/real(n,pReal)*TAU-TAU/real(n*2,pReal))
end function planeCosine
function planeSine(n)
integer, intent(in) :: n
real(pReal), dimension(n) :: planeSine
planeSine = sin(real(math_range(n),pReal)/real(n,pReal)*TAU-TAU/real(n*2,pReal))
end function planeSine
end subroutine selfTest end subroutine selfTest

6
src/homogenization.f90
View File

@ -406,6 +406,9 @@ subroutine homogenization_restartWrite(fileHandle)
call HDF5_write(homogState(ho)%state,groupHandle(2),'omega_mechanical') ! ToDo: should be done by mech call HDF5_write(homogState(ho)%state,groupHandle(2),'omega_mechanical') ! ToDo: should be done by mech
if (damageState_h(ho)%sizeState > 0) &
call HDF5_write(damageState_h(ho)%state,groupHandle(2),'omega_damage') ! ToDo: should be done by mech
call HDF5_closeGroup(groupHandle(2)) call HDF5_closeGroup(groupHandle(2))
end do end do
@ -433,6 +436,9 @@ subroutine homogenization_restartRead(fileHandle)
call HDF5_read(homogState(ho)%state0,groupHandle(2),'omega_mechanical') ! ToDo: should be done by mech call HDF5_read(homogState(ho)%state0,groupHandle(2),'omega_mechanical') ! ToDo: should be done by mech
if (damageState_h(ho)%sizeState > 0) &
call HDF5_read(damageState_h(ho)%state0,groupHandle(2),'omega_damage') ! ToDo: should be done by mech
call HDF5_closeGroup(groupHandle(2)) call HDF5_closeGroup(groupHandle(2))
end do end do

6
src/homogenization_damage.f90
View File

@ -80,11 +80,15 @@ module subroutine damage_partition(ce)
integer, intent(in) :: ce integer, intent(in) :: ce
real(pReal) :: phi real(pReal) :: phi
integer :: co
if (damageState_h(material_homogenizationID(ce))%sizeState < 1) return if (damageState_h(material_homogenizationID(ce))%sizeState < 1) return
phi = damagestate_h(material_homogenizationID(ce))%state(1,material_homogenizationEntry(ce)) phi = damagestate_h(material_homogenizationID(ce))%state(1,material_homogenizationEntry(ce))
call phase_set_phi(phi,1,ce) do co = 1, homogenization_Nconstituents(material_homogenizationID(ce))
call phase_set_phi(phi,co,ce)
end do
end subroutine damage_partition end subroutine damage_partition

64
src/materialpoint.f90
View File

@ -18,6 +18,7 @@ module materialpoint
use math use math
use rotations use rotations
use polynomials use polynomials
use tables
use lattice use lattice
use material use material
use phase use phase
@ -40,37 +41,38 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Initialize all modules. !> @brief Initialize all modules.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine materialpoint_initAll subroutine materialpoint_initAll()
call parallelization_init call parallelization_init()
call CLI_init ! Spectral and FEM interface to commandline call CLI_init() ! grid and mesh commandline interface
call signals_init call signals_init()
call prec_init call prec_init()
call IO_init call IO_init()
#if defined(MESH) #if defined(MESH)
call FEM_quadrature_init call FEM_quadrature_init()
#elif defined(GRID) #elif defined(GRID)
call base64_init call base64_init()
#endif #endif
call YAML_types_init call YAML_types_init()
call YAML_parse_init call YAML_parse_init()
call HDF5_utilities_init call HDF5_utilities_init()
call results_init(restart=CLI_restartInc>0) call results_init(restart=CLI_restartInc>0)
call config_init call config_init()
call math_init call math_init()
call rotations_init call rotations_init()
call polynomials_init call polynomials_init()
call lattice_init call tables_init()
call lattice_init()
#if defined(MESH) #if defined(MESH)
call discretization_mesh_init(restart=CLI_restartInc>0) call discretization_mesh_init(restart=CLI_restartInc>0)
#elif defined(GRID) #elif defined(GRID)
call discretization_grid_init(restart=CLI_restartInc>0) call discretization_grid_init(restart=CLI_restartInc>0)
#endif #endif
call material_init(restart=CLI_restartInc>0) call material_init(restart=CLI_restartInc>0)
call phase_init call phase_init()
call homogenization_init call homogenization_init()
call materialpoint_init call materialpoint_init()
call config_deallocate call config_deallocate()
end subroutine materialpoint_initAll end subroutine materialpoint_initAll
@ -78,7 +80,7 @@ end subroutine materialpoint_initAll
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Read restart information if needed. !> @brief Read restart information if needed.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine materialpoint_init subroutine materialpoint_init()
integer(HID_T) :: fileHandle integer(HID_T) :: fileHandle
@ -103,7 +105,7 @@ end subroutine materialpoint_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Write restart information. !> @brief Write restart information.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine materialpoint_restartWrite subroutine materialpoint_restartWrite()
integer(HID_T) :: fileHandle integer(HID_T) :: fileHandle
@ -123,10 +125,10 @@ end subroutine materialpoint_restartWrite
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Forward data for new time increment. !> @brief Forward data for new time increment.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine materialpoint_forward subroutine materialpoint_forward()
call homogenization_forward call homogenization_forward()
call phase_forward call phase_forward()
end subroutine materialpoint_forward end subroutine materialpoint_forward
@ -139,13 +141,13 @@ subroutine materialpoint_results(inc,time)
integer, intent(in) :: inc integer, intent(in) :: inc
real(pReal), intent(in) :: time real(pReal), intent(in) :: time
call results_openJobFile call results_openJobFile()
call results_addIncrement(inc,time) call results_addIncrement(inc,time)
call phase_results call phase_results()
call homogenization_results call homogenization_results()
call discretization_results call discretization_results()
call results_finalizeIncrement call results_finalizeIncrement()
call results_closeJobFile call results_closeJobFile()
end subroutine materialpoint_results end subroutine materialpoint_results

2
src/parallelization.f90
View File

@ -53,7 +53,7 @@ contains
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Initialize shared memory (openMP) and distributed memory (MPI) parallelization. !> @brief Initialize shared memory (openMP) and distributed memory (MPI) parallelization.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
subroutine parallelization_init subroutine parallelization_init()
integer(MPI_INTEGER_KIND) :: err_MPI, typeSize, version, subversion, devNull integer(MPI_INTEGER_KIND) :: err_MPI, typeSize, version, subversion, devNull
character(len=4) :: rank_str character(len=4) :: rank_str

13
src/phase.f90
View File

@ -9,6 +9,7 @@ module phase
use math use math
use rotations use rotations
use polynomials use polynomials
use tables
use IO use IO
use config use config
use material use material
@ -160,6 +161,11 @@ module phase
integer, intent(in) :: ph integer, intent(in) :: ph
end subroutine thermal_restartWrite end subroutine thermal_restartWrite
module subroutine damage_restartWrite(groupHandle,ph)
integer(HID_T), intent(in) :: groupHandle
integer, intent(in) :: ph
end subroutine damage_restartWrite
module subroutine mechanical_restartRead(groupHandle,ph) module subroutine mechanical_restartRead(groupHandle,ph)
integer(HID_T), intent(in) :: groupHandle integer(HID_T), intent(in) :: groupHandle
integer, intent(in) :: ph integer, intent(in) :: ph
@ -170,6 +176,11 @@ module phase
integer, intent(in) :: ph integer, intent(in) :: ph
end subroutine thermal_restartRead end subroutine thermal_restartRead
module subroutine damage_restartRead(groupHandle,ph)
integer(HID_T), intent(in) :: groupHandle
integer, intent(in) :: ph
end subroutine damage_restartRead
module function mechanical_S(ph,en) result(S) module function mechanical_S(ph,en) result(S)
integer, intent(in) :: ph,en integer, intent(in) :: ph,en
real(pReal), dimension(3,3) :: S real(pReal), dimension(3,3) :: S
@ -674,6 +685,7 @@ subroutine phase_restartWrite(fileHandle)
call mechanical_restartWrite(groupHandle(2),ph) call mechanical_restartWrite(groupHandle(2),ph)
call thermal_restartWrite(groupHandle(2),ph) call thermal_restartWrite(groupHandle(2),ph)
call damage_restartWrite(groupHandle(2),ph)
call HDF5_closeGroup(groupHandle(2)) call HDF5_closeGroup(groupHandle(2))
@ -703,6 +715,7 @@ subroutine phase_restartRead(fileHandle)
call mechanical_restartRead(groupHandle(2),ph) call mechanical_restartRead(groupHandle(2),ph)
call thermal_restartRead(groupHandle(2),ph) call thermal_restartRead(groupHandle(2),ph)
call damage_restartRead(groupHandle(2),ph)
call HDF5_closeGroup(groupHandle(2)) call HDF5_closeGroup(groupHandle(2))

33
src/phase_damage.f90
View File

@ -1,6 +1,6 @@
!---------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief internal microstructure state for all damage sources and kinematics constitutive models !> @brief internal microstructure state for all damage sources and kinematics constitutive models
!---------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
submodule(phase) damage submodule(phase) damage
type :: tDamageParameters type :: tDamageParameters
@ -310,6 +310,35 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
end function integrateDamageState end function integrateDamageState
module subroutine damage_restartWrite(groupHandle,ph)
integer(HID_T), intent(in) :: groupHandle
integer, intent(in) :: ph
select case(phase_damage(ph))
case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID)
call HDF5_write(damageState(ph)%state,groupHandle,'omega_damage')
end select
end subroutine damage_restartWrite
module subroutine damage_restartRead(groupHandle,ph)
integer(HID_T), intent(in) :: groupHandle
integer, intent(in) :: ph
select case(phase_damage(ph))
case(DAMAGE_ISOBRITTLE_ID,DAMAGE_ANISOBRITTLE_ID)
call HDF5_read(damageState(ph)%state0,groupHandle,'omega_damage')
end select
end subroutine damage_restartRead
!---------------------------------------------------------------------------------------------- !----------------------------------------------------------------------------------------------
!< @brief writes damage sources results to HDF5 output file !< @brief writes damage sources results to HDF5 output file
!---------------------------------------------------------------------------------------------- !----------------------------------------------------------------------------------------------

2
src/phase_mechanical_plastic_nonlocal.f90
View File

@ -1783,6 +1783,6 @@ subroutine storeGeometry(ph)
end do end do
end do end do
end subroutine end subroutine storeGeometry
end submodule nonlocal end submodule nonlocal

27
src/phase_thermal_externalheat.f90
View File

@ -11,11 +11,7 @@ submodule(phase:thermal) externalheat
source_thermal_externalheat_offset !< which source is my current thermal dissipation mechanism? source_thermal_externalheat_offset !< which source is my current thermal dissipation mechanism?
type :: tParameters !< container type for internal constitutive parameters type :: tParameters !< container type for internal constitutive parameters
real(pReal), dimension(:), allocatable :: & type(tTable) :: f
t_n, &
f_T
integer :: &
nIntervals
end type tParameters end type tParameters
type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances) type(tParameters), dimension(:), allocatable :: param !< containers of constitutive parameters (len Ninstances)
@ -64,10 +60,7 @@ module function externalheat_init(source_length) result(mySources)
associate(prm => param(ph)) associate(prm => param(ph))
src => sources%get_dict(so) src => sources%get_dict(so)
prm%t_n = src%get_as1dFloat('t_n') prm%f = table(src,'t','f')
prm%nIntervals = size(prm%t_n) - 1
prm%f_T = src%get_as1dFloat('f_T',requiredSize = size(prm%t_n))
Nmembers = count(material_phaseID == ph) Nmembers = count(material_phaseID == ph)
call phase_allocateState(thermalState(ph)%p(so),Nmembers,1,1,0) call phase_allocateState(thermalState(ph)%p(so),Nmembers,1,1,0)
@ -111,23 +104,13 @@ module function externalheat_f_T(ph,en) result(f_T)
f_T f_T
integer :: & integer :: &
so, interval so
real(pReal) :: &
frac_time
so = source_thermal_externalheat_offset(ph) so = source_thermal_externalheat_offset(ph)
associate(prm => param(ph)) associate(prm => param(ph))
do interval = 1, prm%nIntervals ! scan through all rate segments f_T = prm%f%at(thermalState(ph)%p(so)%state(1,en))
frac_time = (thermalState(ph)%p(so)%state(1,en) - prm%t_n(interval)) &
/ (prm%t_n(interval+1) - prm%t_n(interval)) ! fractional time within segment
if ( (frac_time < 0.0_pReal .and. interval == 1) &
.or. (frac_time >= 1.0_pReal .and. interval == prm%nIntervals) &
.or. (frac_time >= 0.0_pReal .and. frac_time < 1.0_pReal) ) &
f_T = prm%f_T(interval ) * (1.0_pReal - frac_time) + &
prm%f_T(interval+1) * frac_time ! interpolate heat rate between segment boundaries...
! ...or extrapolate if outside of bounds
end do
end associate end associate
end function externalheat_f_T end function externalheat_f_T

10
src/polynomials.f90
View File

@ -1,6 +1,6 @@
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, KU Leuven !> @author Martin Diehl, KU Leuven
!> @brief Polynomial representation for variable data !> @brief Polynomial representation for variable data.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module polynomials module polynomials
use prec use prec
@ -19,8 +19,8 @@ module polynomials
end type tPolynomial end type tPolynomial
interface polynomial interface polynomial
module procedure polynomial_from_dict
module procedure polynomial_from_coef module procedure polynomial_from_coef
module procedure polynomial_from_dict
end interface polynomial end interface polynomial
public :: & public :: &
@ -43,7 +43,7 @@ end subroutine polynomials_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Initialize a Polynomial from Coefficients. !> @brief Initialize a polynomial from coefficients.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function polynomial_from_coef(coef,x_ref) result(p) pure function polynomial_from_coef(coef,x_ref) result(p)
@ -59,7 +59,7 @@ end function polynomial_from_coef
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Initialize a Polynomial from a Dictionary with Coefficients. !> @brief Initialize a polynomial from a dictionary with coefficients.
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function polynomial_from_dict(dict,y,x) result(p) function polynomial_from_dict(dict,y,x) result(p)
@ -93,7 +93,7 @@ end function polynomial_from_dict
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief Evaluate a Polynomial. !> @brief Evaluate a polynomial.
!> @details https://nvlpubs.nist.gov/nistpubs/jres/71b/jresv71bn1p11_a1b.pdf (eq. 1.2) !> @details https://nvlpubs.nist.gov/nistpubs/jres/71b/jresv71bn1p11_a1b.pdf (eq. 1.2)
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
pure function eval(self,x) result(y) pure function eval(self,x) result(y)

5
src/prec.f90
View File

@ -26,7 +26,7 @@ module prec
PetscInt, private :: dummy_int PetscInt, private :: dummy_int
integer, parameter :: pPETSCINT = kind(dummy_int) integer, parameter :: pPETSCINT = kind(dummy_int)
PetscScalar, private :: dummy_scalar PetscScalar, private :: dummy_scalar
real(pReal), parameter :: pPETSCSCALAR = kind(dummy_scalar) real(pReal), parameter, private :: pPETSCSCALAR = kind(dummy_scalar)
#endif #endif
integer, parameter :: pSTRINGLEN = 256 !< default string length integer, parameter :: pSTRINGLEN = 256 !< default string length
integer, parameter :: pPATHLEN = 4096 !< maximum length of a path name on linux integer, parameter :: pPATHLEN = 4096 !< maximum length of a path name on linux
@ -254,8 +254,9 @@ subroutine selfTest()
integer(pI64), dimension(1) :: i integer(pI64), dimension(1) :: i
real(pReal), dimension(2) :: r real(pReal), dimension(2) :: r
#ifdef PETSC #ifdef PETSC
if (pReal /= pPETSCSCALAR) error stop 'PetSc and Fortran scalar datatypes do not match' if (pReal /= pPETSCSCALAR) error stop 'PETSc and DAMASK scalar datatypes do not match'
#endif #endif
realloc_lhs_test = [1,2] realloc_lhs_test = [1,2]
if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation' if (any(realloc_lhs_test/=[1,2])) error stop 'LHS allocation'

145
src/tables.f90 Normal file
View File

@ -0,0 +1,145 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, KU Leuven
!> @author Philip Eisenlohr, Michigan State University
!> @brief Tabular representation of variable data.
!--------------------------------------------------------------------------------------------------
module tables
use prec
use IO
use YAML_parse
use YAML_types
implicit none(type,external)
private
type, public :: tTable
real(pReal), dimension(:), allocatable :: x,y
contains
procedure, public :: at => eval
end type tTable
interface table
module procedure table_from_values
module procedure table_from_dict
end interface table
public :: &
table, &
tables_init
contains
!--------------------------------------------------------------------------------------------------
!> @brief Run self-test.
!--------------------------------------------------------------------------------------------------
subroutine tables_init()
print'(/,1x,a)', '<<<+- tables init -+>>>'; flush(IO_STDOUT)
call selfTest()
end subroutine tables_init
!--------------------------------------------------------------------------------------------------
!> @brief Initialize a table from values.
!--------------------------------------------------------------------------------------------------
function table_from_values(x,y) result(t)
real(pReal), dimension(:), intent(in) :: x,y
type(tTable) :: t
if (size(x) < 1) call IO_error(603,ext_msg='missing tabulated x data')
if (size(y) < 1) call IO_error(603,ext_msg='missing tabulated y data')
if (size(x) /= size(y)) call IO_error(603,ext_msg='shape mismatch in tabulated data')
if (size(x) /= 1) then
if (any(x(2:size(x))-x(1:size(x)-1) <= 0.0_pReal)) &
call IO_error(603,ext_msg='ordinate data does not increase monotonically')
end if
t%x = x
t%y = y
end function table_from_values
!--------------------------------------------------------------------------------------------------
!> @brief Initialize a table from a dictionary with values.
!--------------------------------------------------------------------------------------------------
function table_from_dict(dict,x_label,y_label) result(t)
type(tDict), intent(in) :: dict
character(len=*), intent(in) :: x_label, y_label
type(tTable) :: t
t = tTable(dict%get_as1dFloat(x_label),dict%get_as1dFloat(y_label))
end function table_from_dict
!--------------------------------------------------------------------------------------------------
!> @brief Linearly interpolate/extrapolate tabular data.
!--------------------------------------------------------------------------------------------------
pure function eval(self,x) result(y)
class(tTable), intent(in) :: self
real(pReal), intent(in) :: x
real(pReal) :: y
integer :: i
if (size(self%x) == 1) then
y = self%y(1)
else
i = max(1,min(findloc(self%x<x,.true.,dim=1,back=.true.),size(self%x)-1))
y = self%y(i) &
+ (x-self%x(i)) * (self%y(i+1)-self%y(i)) / (self%x(i+1)-self%x(i))
end if
end function eval
!--------------------------------------------------------------------------------------------------
!> @brief Check correctness of table functionality.
!--------------------------------------------------------------------------------------------------
subroutine selfTest()
type(tTable) :: t
real(pReal), dimension(*), parameter :: &
x = real([ 1., 2., 3., 4.],pReal), &
y = real([ 1., 3., 2.,-2.],pReal), &
x_eval = real([ 0.0, 0.5, 1.0, 1.5, 2.0, 2.5, 3.0, 3.5, 4.0, 4.5, 5.0],pReal), &
y_true = real([-1.0, 0.0, 1.0, 2.0, 3.0, 2.5 ,2.0, 0.0,-2.0,-4.0,-6.0],pReal)
integer :: i
type(tDict), pointer :: dict
type(tList), pointer :: l_x, l_y
real(pReal) :: r
call random_number(r)
t = table(real([0.],pReal),real([r],pReal))
if (dNeq(r,t%at(r),1.0e-9_pReal)) error stop 'table eval/mono'
r = r-0.5_pReal
t = table(x+r,y)
do i = 1, size(x_eval)
if (dNeq(y_true(i),t%at(x_eval(i)+r),1.0e-9_pReal)) error stop 'table eval/values'
end do
l_x => YAML_parse_str_asList('[1, 2, 3, 4]'//IO_EOL)
l_y => YAML_parse_str_asList('[1, 3, 2,-2]'//IO_EOL)
allocate(dict)
call dict%set('t',l_x)
call dict%set('T',l_y)
t = table(dict,'t','T')
do i = 1, size(x_eval)
if (dNeq(y_true(i),t%at(x_eval(i)))) error stop 'table eval/dict'
end do
end subroutine selfTest
end module tables