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

Merge branch 'development' into 21_removeperformanceprofiling

This commit is contained in:
Martin Diehl 2018-06-28 13:09:11 +02:00
parent c45d9f9ee9 5e5f975bff
commit a308b2130a
86 changed files with 2363 additions and 2338 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
.gitlab-ci.yml
View File

@ -7,10 +7,7 @@ stages:
- compileSpectralGNU
- prepareSpectral
- spectral
- compileMarc2014
- compileMarc2014.2
- compileMarc2015
- compileMarc2016
- compileMarc2017
- marc
- compileAbaqus2016
- compileAbaqus2017
@ -51,34 +48,31 @@ variables:
# ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++
IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016"
IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017"
GNUCompiler5_3: "Compiler/GNU/5.3"
IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018"
GNUCompiler7_3: "Compiler/GNU/7.3"
# ------------ Defaults ----------------------------------------------
IntelCompiler: "$IntelCompiler17_0"
GNUCompiler: "$GNUCompiler5_3"
IntelCompiler: "$IntelCompiler18_1"
GNUCompiler: "$GNUCompiler7_3"
# ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++
MPICH3_2Intel17_0: "MPI/Intel/17.0/MPICH/3.2"
MPICH3_2GNU5_3: "MPI/GNU/5.3/MPICH/3.2"
MPICH3_2Intel18_1: "MPI/Intel/18.1/MPICH/3.2.1"
MPICH3_2GNU7_3: "MPI/GNU/7.3/MPICH/3.2.1"
# ------------ Defaults ----------------------------------------------
MPICH_GNU: "$MPICH3_2GNU5_3"
MPICH_Intel: "$MPICH3_2Intel17_0"
MPICH_GNU: "$MPICH3_2GNU7_3"
MPICH_Intel: "$MPICH3_2Intel18_1"
# ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++
PETSc3_7_6MPICH3_2Intel17_0: "Libraries/PETSc/3.7.6/Intel-17.0-MPICH-3.2"
PETSc3_7_5MPICH3_2Intel17_0: "Libraries/PETSc/3.7.5/Intel-17.0-MPICH-3.2"
PETSc3_6_4MPICH3_2Intel17_0: "Libraries/PETSc/3.6.4/Intel-17.0-MPICH-3.2"
PETSc3_7_5MPICH3_2GNU5_3: "Libraries/PETSc/3.7.5/GNU-5.3-MPICH-3.2"
PETSc3_9_1MPICH3_2Intel18_1: "Libraries/PETSc/3.9.1/Intel-18.1-MPICH-3.2.1"
PETSc3_9_1MPICH3_2GNU7_3: "Libraries/PETSc/3.9.1/GNU-7.3-MPICH-3.2.1"
# ------------ Defaults ----------------------------------------------
PETSc_MPICH_Intel: "$PETSc3_7_6MPICH3_2Intel17_0"
PETSc_MPICH_GNU: "$PETSc3_7_5MPICH3_2GNU5_3"
PETSc_MPICH_Intel: "$PETSc3_9_1MPICH3_2Intel18_1"
PETSc_MPICH_GNU: "$PETSc3_9_1MPICH3_2GNU7_3"
# ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++
Abaqus2016: "FEM/Abaqus/2016"
Abaqus2017: "FEM/Abaqus/2017"
MSC2014: "FEM/MSC/2014"
MSC2014_2: "FEM/MSC/2014.2"
MSC2015: "FEM/MSC/2015"
MSC2016: "FEM/MSC/2016"
MSC2017: "FEM/MSC/2017"
# ------------ Defaults ----------------------------------------------
Abaqus: "$Abaqus2017"
MSC: "$MSC2016"
MSC: "$MSC2017"
# ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++
Doxygen1_8_13: "Documentation/Doxygen/1.8.13"
# ------------ Defaults ----------------------------------------------
@ -324,42 +318,20 @@ HybridIA:
- master
- release
###################################################################################################
Marc_compileIfort2014:
stage: compileMarc2014
script:
- module load $IntelCompiler16_0 $MSC2014
- Marc_compileIfort/test.py -m 2014
TextureComponents:
stage: spectral
script: TextureComponents/test.py
except:
- master
- release
###################################################################################################
Marc_compileIfort2014.2:
stage: compileMarc2014.2
script:
- module load $IntelCompiler16_0 $MSC2014_2
- Marc_compileIfort/test.py -m 2014.2
except:
- master
- release
###################################################################################################
Marc_compileIfort2015:
stage: compileMarc2015
Marc_compileIfort2017:
stage: compileMarc2017
script:
- module load $IntelCompiler16_0 $MSC2015
- Marc_compileIfort/test.py -m 2015
except:
- master
- release
###################################################################################################
Marc_compileIfort2016:
stage: compileMarc2016
script:
- module load $IntelCompiler16_0 $MSC2016
- Marc_compileIfort/test.py -m 2016
- module load $IntelCompiler17_0 $MSC2017
- Marc_compileIfort/test.py -m 2017
except:
- master
- release
@ -368,7 +340,7 @@ Marc_compileIfort2016:
Hex_elastic:
stage: marc
script:
- module load $IntelCompiler16_0 $MSC
- module load $IntelCompiler17_0 $MSC
- Hex_elastic/test.py
except:
- master
@ -377,7 +349,7 @@ Hex_elastic:
CubicFCC_elastic:
stage: marc
script:
- module load $IntelCompiler16_0 $MSC
- module load $IntelCompiler17_0 $MSC
- CubicFCC_elastic/test.py
except:
- master
@ -386,7 +358,7 @@ CubicFCC_elastic:
CubicBCC_elastic:
stage: marc
script:
- module load $IntelCompiler16_0 $MSC
- module load $IntelCompiler17_0 $MSC
- CubicBCC_elastic/test.py
except:
- master
@ -395,7 +367,7 @@ CubicBCC_elastic:
J2_plasticBehavior:
stage: marc
script:
- module load $IntelCompiler16_0 $MSC
- module load $IntelCompiler17_0 $MSC
- J2_plasticBehavior/test.py
except:
- master

76
CMakeLists.txt
View File

@ -5,8 +5,8 @@ cmake_minimum_required (VERSION 2.8.8 FATAL_ERROR)
#---------------------------------------------------------------------------------------
# Find PETSc from system environment
set(PETSC_DIR $ENV{PETSC_DIR})
if ("${PETSC_DIR}" STREQUAL "")
message (FATAL_ERROR "PETSC_DIR is not defined")
if (PETSC_DIR STREQUAL "")
message (FATAL_ERROR "PETSc location (PETSC_DIR) is not defined")
endif ()
set (petsc_conf_variables "${PETSC_DIR}/lib/petsc/conf/variables")
@ -105,52 +105,54 @@ set (CMAKE_C_COMPILER "${PETSC_MPICC}")
# Now start to care about DAMASK
# DAMASK solver defines project to build
if ("${DAMASK_SOLVER}" STREQUAL "SPECTRAL")
if (DAMASK_SOLVER STREQUAL "SPECTRAL")
project (DAMASK_spectral Fortran C)
add_definitions (-DSpectral)
message ("Building Spectral Solver\n")
elseif ("${DAMASK_SOLVER}" STREQUAL "FEM")
elseif (DAMASK_SOLVER STREQUAL "FEM")
project (DAMASK_FEM Fortran C)
add_definitions (-DFEM)
message ("Building FEM Solver\n")
else ()
message (FATAL_ERROR "Build target (DAMASK_SOLVER) is not defined")
endif ()
# set linker commands (needs to be done after defining the project)
set (CMAKE_LINKER "${PETSC_LINKER}")
if ("${CMAKE_BUILD_TYPE}" STREQUAL "")
if (CMAKE_BUILD_TYPE STREQUAL "")
set (CMAKE_BUILD_TYPE "RELEASE")
endif ()
# Predefined sets for OPTIMIZATION/OPENMP based on BUILD_TYPE
if ("${CMAKE_BUILD_TYPE}" STREQUAL "DEBUG" OR "${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY" )
if (CMAKE_BUILD_TYPE STREQUAL "DEBUG" OR CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
set (DEBUG_FLAGS "${DEBUG_FLAGS} -DDEBUG")
set (PARALLEL "OFF")
set (OPTI "OFF")
elseif ("${CMAKE_BUILD_TYPE}" STREQUAL "RELEASE")
elseif (CMAKE_BUILD_TYPE STREQUAL "RELEASE")
set (PARALLEL "ON")
set (OPTI "DEFENSIVE")
elseif ("${CMAKE_BUILD_TYPE}" STREQUAL "PERFORMANCE")
elseif (CMAKE_BUILD_TYPE STREQUAL "PERFORMANCE")
set (PARALLEL "ON")
set (OPTI "AGGRESSIVE")
endif ()
# $OPTIMIZATION takes precedence over $BUILD_TYPE defaults
if ("${OPTIMIZATION}" STREQUAL "")
if (OPTIMIZATION STREQUAL "")
set (OPTIMIZATION "${OPTI}")
else ()
set (OPTIMIZATION "${OPTIMIZATION}")
endif ()
# $OPENMP takes precedence over $BUILD_TYPE defaults
if ("${OPENMP}" STREQUAL "")
if (OPENMP STREQUAL "")
set (OPENMP "${PARALLEL}")
else ()
set(OPENMP "${OPENMP}")
endif ()
# syntax check only (mainly for pre-receive hook, works only with gfortran)
if ("${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY" )
if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
set (BUILDCMD_POST "${BUILDCMD_POST} -fsyntax-only")
endif ()
@ -188,22 +190,24 @@ set (DAMASK_INCLUDE_FLAGS "${DAMASK_INCLUDE_FLAGS} ${PETSC_INCLUDES}")
###################################################################################################
# Intel Compiler
###################################################################################################
if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
if (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel")
if (OPENMP)
set (OPENMP_FLAGS "-qopenmp -parallel")
endif ()
if ("${OPTIMIZATION}" STREQUAL "OFF")
set (OPTIMIZATION_FLAGS "-O0 -no-ip")
elseif ("${OPTIMIZATION}" STREQUAL "DEFENSIVE")
set (OPTIMIZATION_FLAGS "-O2")
elseif ("${OPTIMIZATION}" STREQUAL "AGGRESSIVE")
set (OPTIMIZATION_FLAGS "-ipo -O3 -no-prec-div -fp-model fast=2 -xHost")
# -fast = -ipo, -O3, -no-prec-div, -static, -fp-model fast=2, and -xHost"
if (OPTIMIZATION STREQUAL "OFF")
set (OPTIMIZATION_FLAGS "-O0 -no-ip")
elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
set (OPTIMIZATION_FLAGS "-O2")
elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
set (OPTIMIZATION_FLAGS "-ipo -O3 -no-prec-div -fp-model fast=2 -xHost")
# -fast = -ipo, -O3, -no-prec-div, -static, -fp-model fast=2, and -xHost"
endif ()
set (STANDARD_CHECK "-stand f08 -standard-semantics")
# -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules
# (PETSc, HDF5) are not compiled with this option (https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/62172)
set (STANDARD_CHECK "-stand f08 -standard-semantics -assume nostd_mod_proc_name")
set (LINKER_FLAGS "${LINKER_FLAGS} -shared-intel")
# Link against shared Intel libraries instead of static ones
@ -215,13 +219,6 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
set (COMPILE_FLAGS "${COMPILE_FLAGS} -ftz")
# flush underflow to zero, automatically set if -O[1,2,3]
set (COMPILE_FLAGS "${COMPILE_FLAGS} -assume")
# assume ...
set (COMPILE_FLAGS "${COMPILE_FLAGS} byterecl")
# ... record length is given in bytes (also set by -standard-semantics)
set (COMPILE_FLAGS "${COMPILE_FLAGS},fpe_summary")
# ... print list of floating point exceptions occured during execution
set (COMPILE_FLAGS "${COMPILE_FLAGS} -diag-disable")
# disables warnings ...
set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268")
@ -313,18 +310,18 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel")
###################################################################################################
# GNU Compiler
###################################################################################################
elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU")
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
if (OPENMP)
set (OPENMP_FLAGS "-fopenmp")
endif ()
if ("${OPTIMIZATION}" STREQUAL "OFF")
set (OPTIMIZATION_FLAGS "-O0" )
elseif ("${OPTIMIZATION}" STREQUAL "DEFENSIVE")
set (OPTIMIZATION_FLAGS "-O2")
elseif ("${OPTIMIZATION}" STREQUAL "AGGRESSIVE")
set (OPTIMIZATION_FLAGS "-O3 -ffast-math -funroll-loops -ftree-vectorize")
if (OPTIMIZATION STREQUAL "OFF")
set (OPTIMIZATION_FLAGS "-O0" )
elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
set (OPTIMIZATION_FLAGS "-O2")
elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
set (OPTIMIZATION_FLAGS "-O3 -ffast-math -funroll-loops -ftree-vectorize")
endif ()
set (STANDARD_CHECK "-std=f2008ts -pedantic-errors" )
@ -448,12 +445,15 @@ elseif(${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU")
# Additional options
# -fdefault-integer-8: Use it to set precision to 8 bytes for integer, don't use it for the standard case of pInt=4 (there is no -fdefault-integer-4)
else ()
message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized")
endif ()
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS} ${PRECISION_FLAGS}")
set (CMAKE_Fortran_LINK_EXECUTABLE "${BUILDCMD_PRE} ${CMAKE_LINKER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}")
if ("${CMAKE_BUILD_TYPE}" STREQUAL "DEBUG")
if (CMAKE_BUILD_TYPE STREQUAL "DEBUG")
set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${DEBUG_FLAGS}")
set (CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} ${DEBUG_FLAGS}")
endif ()
@ -469,15 +469,15 @@ message ("Fortran Linker Command:\n${CMAKE_Fortran_LINK_EXECUTABLE}\n")
add_subdirectory (src)
# INSTALL BUILT BINARIES
if ("${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY")
if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
exec_program (mktemp ARGS -d OUTPUT_VARIABLE BLACK_HOLE)
install (PROGRAMS ${PROJECT_BINARY_DIR}/src/prec.mod
DESTINATION ${BLACK_HOLE})
else ()
if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_spectral
DESTINATION ${CMAKE_INSTALL_PREFIX})
elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
install (PROGRAMS ${PROJECT_BINARY_DIR}/src/DAMASK_FEM
DESTINATION ${CMAKE_INSTALL_PREFIX})
endif ()

2
CONFIG
View File

@ -6,6 +6,6 @@ set DAMASK_BIN = ${DAMASK_ROOT}/bin
set DAMASK_NUM_THREADS = 4
set MSC_ROOT = /opt/msc
set MARC_VERSION = 2016
set MARC_VERSION = 2017
set ABAQUS_VERSION = 2017

1
DAMASK_env.csh
View File

@ -1 +0,0 @@
env/DAMASK.csh

1
DAMASK_env.sh
View File

@ -1 +0,0 @@
env/DAMASK.sh

1
DAMASK_env.zsh
View File

@ -1 +0,0 @@
env/DAMASK.zsh

2
DAMASK_prerequisites.sh
View File

@ -23,7 +23,7 @@ if which $1 &> /dev/null; then
$1 $2
echo -e '\n'
else
echo $ does not exist
echo $1 not found
fi
}

1
Makefile
View File

@ -25,7 +25,6 @@ build/FEM:
.PHONY: marc
marc:
@./installation/symLink_Code.sh
@./installation/mods_MarcMentat/apply_DAMASK_modifications.sh ${MAKEFLAGS}
.PHONY: clean

2
PRIVATE

@ -1 +1 @@
Subproject commit b7d1d309146e017caa5744333c2e4a4532a6fc20
Subproject commit aead92902b3a0cf3404be9c552bfec918d7aaffb

2
VERSION
View File

@ -1 +1 @@
v2.0.1-1144-g5f28fa0
v2.0.2-48-gaebb06e

8
env/DAMASK.sh vendored
View File

@ -2,7 +2,7 @@
# usage: source DAMASK.sh
function canonicalPath {
python -c "import os,sys; print(os.path.realpath(os.path.expanduser(sys.argv[1])))" $1
python -c "import os,sys; print(os.path.normpath(os.path.realpath(os.path.expanduser(sys.argv[1]))))" $1
}
function blink {
@ -17,12 +17,8 @@ else
DAMASK_ROOT=${STAT##* }
fi
# transition compatibility (renamed $DAMASK_ROOT/DAMASK_env.sh to $DAMASK_ROOT/env/DAMASK.sh)
if [ ${BASH_SOURCE##*/} == "DAMASK.sh" ]; then
DAMASK_ROOT="$DAMASK_ROOT/.."
fi
DAMASK_ROOT=$(canonicalPath "$DAMASK_ROOT/../")
DAMASK_ROOT=$(canonicalPath $DAMASK_ROOT)
# shorthand command to change to DAMASK_ROOT directory
eval "function DAMASK_root() { cd $DAMASK_ROOT; }"

31
env/DAMASK.zsh vendored
View File

@ -2,15 +2,14 @@
# usage: source DAMASK.zsh
function canonicalPath {
python -c "import os,sys; print(os.path.realpath(os.path.expanduser(sys.argv[1])))" $1
python -c "import os,sys; print(os.path.normpath(os.path.realpath(os.path.expanduser(sys.argv[1]))))" $1
}
# transition compatibility (renamed $DAMASK_ROOT/DAMASK_env.zsh to $DAMASK_ROOT/env/DAMASK.zsh)
if [ ${0:t:r} = 'DAMASK' ]; then
DAMASK_ROOT=${0:a:h}'/..'
else
DAMASK_ROOT=${0:a:h}
fi
function blink {
echo -e "\033[2;5m$1\033[0m"
}
DAMASK_ROOT=$(canonicalPath "${0:a:h}'/..")
# shorthand command to change to DAMASK_ROOT directory
eval "function DAMASK_root() { cd $DAMASK_ROOT; }"
@ -25,13 +24,13 @@ unset -f set
# add DAMASK_BIN if present
[ "x$DAMASK_BIN != x" ] && PATH=$DAMASK_BIN:$PATH
SOLVER=$(type -p DAMASK_spectral || true 2>/dev/null)
[ "x$SOLVER == x" ] && SOLVER='Not found!'
SOLVER=$(which DAMASK_spectral || true 2>/dev/null)
[ "x$SOLVER" = "x" ] && SOLVER=$(blink 'Not found!')
PROCESSING=$(type -p postResults || true 2>/dev/null)
[ "x$PROCESSING == x" ] && PROCESSING='Not found!'
PROCESSING=$(which postResults || true 2>/dev/null)
[ "x$PROCESSING" = "x" ] && PROCESSING=$(blink 'Not found!')
[ "x$DAMASK_NUM_THREADS == x" ] && DAMASK_NUM_THREADS=1
[ "x$DAMASK_NUM_THREADS" = "x" ] && DAMASK_NUM_THREADS=1
# currently, there is no information that unlimited causes problems
# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it
@ -52,16 +51,18 @@ if [ ! -z "$PS1" ]; then
echo "DAMASK $DAMASK_ROOT"
echo "Spectral Solver $SOLVER"
echo "Post Processing $PROCESSING"
echo "Multithreading DAMASK_NUM_THREADS=$DAMASK_NUM_THREADS"
if [ "x$PETSC_DIR" != "x" ]; then
echo "PETSc location $PETSC_DIR"
echo -n "PETSc location "
[ -d $PETSC_DIR ] && echo $PETSC_DIR || blink $PETSC_DIR
[[ $(canonicalPath "$PETSC_DIR") == $PETSC_DIR ]] \
|| echo " ~~> "$(canonicalPath "$PETSC_DIR")
fi
[[ "x$PETSC_ARCH" == "x" ]] \
|| echo "PETSc architecture $PETSC_ARCH"
echo "MSC.Marc/Mentat $MSC_ROOT"
echo -n "MSC.Marc/Mentat "
[ -d $MSC_ROOT ] && echo $MSC_ROOT || blink $MSC_ROOT
echo
echo "Multithreading DAMASK_NUM_THREADS=$DAMASK_NUM_THREADS"
echo -n "heap size "
[[ "$(ulimit -d)" == "unlimited" ]] \
&& echo "unlimited" \

2
examples/SpectralMethod/Polycrystal/material.config
View File

@ -3,7 +3,7 @@
#-------------------#
[SX]
type none
mech none
#-------------------#
<crystallite>

30
installation/mods_Abaqus/abaqus_v6.env
View File

@ -16,24 +16,26 @@ from damask import version as DAMASKVERSION
# Use the version in $PATH
fortCmd = "ifort"
# -free to use free-format FORTRAN 90 syntax
# -O <0-3> optimization level
# -fpp use FORTRAN preprocessor on source code
# -openmp build with openMP support
# -w90 -w95 suppress messages about use of non-standard Fortran (previous version of abaqus_v6.env only)
# -WB turn a compile-time bounds check into a warning (previous version of abaqus_v6.env only)
# -mP2OPT_hpo_vec_divbyzero=F inofficial compiler switch, proposed by abaqus but highly dubios (previous version of abaqus_v6.env only)
# -ftz flush underflow to zero
# -diag-disable 5268 disable warnings about line length > 132 (only comments there anyway)
# -implicitnone assume no implicit types (e.g. i for integer)
# -assume byterecl count record length in bytes
# -real-size 64 -DFLOAT=8 assume size of real to be 8 bytes, matches our definition of pReal
# -integer-size 32 -DINT=4 assume size of integer to be 4 bytes, matches our definition of pInt
# -free to use free-format FORTRAN 90 syntax
# -O <0-3> optimization level
# -fpp use FORTRAN preprocessor on source code
# -openmp build with openMP support
# -w90 -w95 suppress messages about use of non-standard Fortran (previous version of abaqus_v6.env only)
# -WB turn a compile-time bounds check into a warning (previous version of abaqus_v6.env only)
# -mP2OPT_hpo_vec_divbyzero=F inofficial compiler switch, proposed by abaqus but highly dubios (previous version of abaqus_v6.env only)
# -ftz flush underflow to zero
# -diag-disable 5268 disable warnings about line length > 132 (only comments there anyway)
# -implicitnone assume no implicit types (e.g. i for integer)
# -standard-semantics sets standard (Fortran 2008) and some other conventions
# -assume nostd_mod_proc_name avoid problems with libraries compiled without that option
# -real-size 64 -DFLOAT=8 assume size of real to be 8 bytes, matches our definition of pReal
# -integer-size 32 -DINT=4 assume size of integer to be 4 bytes, matches our definition of pInt
compile_fortran = (fortCmd + " -c -fPIC -auto -shared-intel " +
"-I%I -free -O1 -fpp -openmp " +
"-ftz -diag-disable 5268 " +
"-implicitnone -assume byterecl -stand f08 -standard-semantics " +
"-implicitnone -standard-semantics " +
"-assume nostd_mod_proc_name " +
"-real-size 64 -integer-size 32 -DFLOAT=8 -DINT=4 " +
'-DDAMASKVERSION=\\\"%s\\\"'%DAMASKVERSION)

29
installation/mods_Abaqus/abaqus_v6_serial.env
View File

@ -16,24 +16,25 @@ from damask import version as DAMASKVERSION
# Use the version in $PATH
fortCmd = "ifort"
# -free to use free-format FORTRAN 90 syntax
# -O <0-3> optimization level
# -fpp use FORTRAN preprocessor on source code
# -openmp build with openMP support
# -w90 -w95 suppress messages about use of non-standard Fortran (previous version of abaqus_v6.env only)
# -WB turn a compile-time bounds check into a warning (previous version of abaqus_v6.env only)
# -mP2OPT_hpo_vec_divbyzero=F inofficial compiler switch, proposed by abaqus but highly dubios (previous version of abaqus_v6.env only)
# -ftz flush underflow to zero
# -diag-disable 5268 disable warnings about line length > 132 (only comments there anyway)
# -implicitnone assume no implicit types (e.g. i for integer)
# -assume byterecl count record length in bytes
# -real-size 64 -DFLOAT=8 assume size of real to be 8 bytes, matches our definition of pReal
# -integer-size 32 -DINT=4 assume size of integer to be 4 bytes, matches our definition of pInt
# -free to use free-format FORTRAN 90 syntax
# -O <0-3> optimization level
# -fpp use FORTRAN preprocessor on source code
# -w90 -w95 suppress messages about use of non-standard Fortran (previous version of abaqus_v6.env only)
# -WB turn a compile-time bounds check into a warning (previous version of abaqus_v6.env only)
# -mP2OPT_hpo_vec_divbyzero=F inofficial compiler switch, proposed by abaqus but highly dubios (previous version of abaqus_v6.env only)
# -ftz flush underflow to zero
# -diag-disable 5268 disable warnings about line length > 132 (only comments there anyway)
# -implicitnone assume no implicit types (e.g. i for integer)
# -standard-semantics sets standard (Fortran 2008) and some other conventions
# -assume nostd_mod_proc_name avoid problems with libraries compiled without that option
# -real-size 64 -DFLOAT=8 assume size of real to be 8 bytes, matches our definition of pReal
# -integer-size 32 -DINT=4 assume size of integer to be 4 bytes, matches our definition of pInt
compile_fortran = (fortCmd + " -c -fPIC -auto -shared-intel " +
"-I%I -free -O1 -fpp " +
"-ftz -diag-disable 5268 " +
"-implicitnone -assume byterecl -stand f08 -standard-semantics " +
"-implicitnone -standard-semantics " +
"-assume nostd_mod_proc_name " +
"-real-size 64 -integer-size 32 -DFLOAT=8 -DINT=4 " +
'-DDAMASKVERSION=\\\"%s\\\"'%DAMASKVERSION)

14
installation/mods_MarcMentat/2014.2/Marc_tools/include_linux64
View File

@ -416,7 +416,7 @@ then
PROFILE=" $PROFILE -pg"
fi
FORT_OPT="-c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr -mp1 -WB"
FORT_OPT="-c -implicitnone -stand f08 -standard-semantics -assume nostd_std_mod_proc_name -safe_cray_ptr -mp1 -WB"
if test "$MTHREAD" = "OPENMP"
then
FORT_OPT=" $FORT_OPT -openmp"
@ -458,21 +458,21 @@ DAMASKVERSION="'"$DAMASKVERSION"'"
DFORTLOW="$FCOMP $FORT_OPT $PROFILE -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_std_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_std_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_std_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
@ -492,21 +492,21 @@ then
DFORTLOW="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_std_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=2014.2.2 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_std_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=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_std_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014.2 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"

14
installation/mods_MarcMentat/2014/Marc_tools/include_linux64
View File

@ -410,7 +410,7 @@ then
PROFILE="-prof-gen=srcpos"
fi
FORT_OPT="-c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr -mp1 -WB"
FORT_OPT="-c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr -mp1 -WB"
if test "$MTHREAD" = "OPENMP"
then
FORT_OPT=" $FORT_OPT -openmp"
@ -452,21 +452,21 @@ DAMASKVERSION="'"$DAMASKVERSION"'"
DFORTLOW="$FCOMP $FORT_OPT $PROFILE -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
@ -486,21 +486,21 @@ then
DFORTLOW="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -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=2014 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -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=2014 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2014 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"

14
installation/mods_MarcMentat/2015/Marc_tools/include_linux64
View File

@ -419,7 +419,7 @@ then
PROFILE=" $PROFILE -pg"
fi
FORT_OPT="-c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr -mp1 -WB"
FORT_OPT="-c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr -mp1 -WB"
if test "$MTHREAD" = "OPENMP"
then
FORT_OPT=" $FORT_OPT -openmp"
@ -454,21 +454,21 @@ fi
DFORTLOW="$FCOMP $FORT_OPT $PROFILE -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
@ -488,21 +488,21 @@ then
DFORTLOW="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -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=2015 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -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=2015 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2015 -DDAMASKVERSION=$DAMASKVERSION \
-openmp -openmp_report2 -openmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"

14
installation/mods_MarcMentat/2016/Marc_tools/include_linux64
View File

@ -449,7 +449,7 @@ then
PROFILE=" $PROFILE -pg"
fi
FORT_OPT="-c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr -mp1 -WB -fp-model source"
FORT_OPT="-c -implicitnone -stand f08 -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"
@ -484,21 +484,21 @@ fi
DFORTLOW="$FCOMP $FORT_OPT $PROFILE -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
@ -518,21 +518,21 @@ then
DFORTLOW="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -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=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -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=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS"

14
installation/mods_MarcMentat/2017/Marc_tools/include_linux64
View File

@ -457,7 +457,7 @@ then
PROFILE=" $PROFILE -pg"
fi
FORT_OPT="-c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr -mp1 -WB -fp-model source"
FORT_OPT="-c -implicitnone -stand f08 -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"
@ -494,21 +494,21 @@ fi
DFORTLOW="$FCOMP $FORT_OPT $PROFILE -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O0 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -O1 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias -O2 $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
@ -528,21 +528,21 @@ then
DFORTLOW="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTLOWMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTLOWMP="$FCOMP -c -implicitnone -stand f08 -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=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTRAN="$FCOMP $FORT_OPT $PROFILE $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTRANMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB $I8FFLAGS -I$MARC_SOURCE/common \
DFORTRANMP="$FCOMP -c -implicitnone -stand f08 -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=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTHIGH="$FCOMP $FORT_OPT $PROFILE -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-enable sc3 -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
DFORTHIGHMP="$FCOMP -c -assume byterecl -stand f08 -standard-semantics -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
DFORTHIGHMP="$FCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -safe_cray_ptr $PROFILE -zero -mp1 -WB -fno-alias $I8FFLAGS -I$MARC_SOURCE/common \
-fpp -ftz -diag-disable 5268 -warn declarations -warn general -warn usage -warn interfaces -warn ignore_loc -warn alignments -DMarc4DAMASK=2016 -DDAMASKVERSION=$DAMASKVERSION \
-qopenmp -qopenmp-threadprivate=compat\
-I$MARC_SOURCE/${BCS_DIR}/common -I$MARC_SOURCE/mumpssolver/include $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"

2
installation/mods_MarcMentat/installation.txt
View File

@ -16,7 +16,7 @@ The Intel Fortran compiler needs to be installed.
APPENDIX:
The structure of this directory should be (VERSION = 2010.2 or 2011 or 2012 or 2013 or 2014):
The structure of this directory should be (VERSION = 20XX or 20XX.Y)
./installation.txt this text
./apply_MPIE_modifications script file to apply modifications to the installation

4
lib/damask/solver/marc.py
View File

@ -9,10 +9,8 @@ class Marc(Solver):
def __init__(self):
self.solver = 'Marc'
self.releases = { \
'2017': ['linux64',''],
'2016': ['linux64',''],
'2015': ['linux64',''],
'2014.2':['linux64',''],
'2014' :['linux64',''],
}

2
processing/post/addAPS34IDEstrainCoords.py
View File

@ -74,7 +74,7 @@ for name in filenames:
# ------------------------------------------ process data ------------------------------------------
theta=-0.75*np.pi
RotMat2TSL=np.array([[1., 0., 0.],
RotMat2TSL=np.array([[1., 0., 0.],
[0., np.cos(theta), np.sin(theta)], # Orientation to account for -135 deg
[0., -np.sin(theta), np.cos(theta)]]) # rotation for TSL convention
vec = np.zeros(4)

27
src/CMakeLists.txt
View File

@ -1,5 +1,5 @@
# special flags for some files
if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU")
if (CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
SET_SOURCE_FILES_PROPERTIES( "lattice.f90" PROPERTIES
COMPILE_FLAGS "-ffree-line-length-240")
# long lines for interaction matrix
@ -15,15 +15,16 @@ add_dependencies(SYSTEM_ROUTINES C_ROUTINES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:SYSTEM_ROUTINES>)
add_library(PREC OBJECT "prec.f90")
add_dependencies(PREC SYSTEM_ROUTINES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:PREC>)
if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
add_library(DAMASK_INTERFACE OBJECT "spectral_interface.f90")
elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(DAMASK_INTERFACE OBJECT "FEM_interface.f90")
else ()
message (FATAL_ERROR "Build target (PROJECT_NAME) is not defined")
endif()
add_dependencies(DAMASK_INTERFACE PREC)
add_dependencies(DAMASK_INTERFACE PREC SYSTEM_ROUTINES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_INTERFACE>)
add_library(IO OBJECT "IO.f90")
@ -38,6 +39,10 @@ add_library(DEBUG OBJECT "debug.f90")
add_dependencies(DEBUG NUMERICS)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DEBUG>)
add_library(CONFIG OBJECT "config.f90")
add_dependencies(CONFIG DEBUG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:CONFIG>)
add_library(FEsolving OBJECT "FEsolving.f90")
add_dependencies(FEsolving DEBUG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEsolving>)
@ -47,11 +52,11 @@ add_dependencies(DAMASK_MATH FEsolving)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_MATH>)
# SPECTRAL solver and FEM solver use different mesh files
if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
add_library(MESH OBJECT "mesh.f90")
add_dependencies(MESH DAMASK_MATH)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MESH>)
elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(FEZoo OBJECT "FEZoo.f90")
add_dependencies(FEZoo DAMASK_MATH)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEZoo>)
@ -61,7 +66,7 @@ elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
endif()
add_library(MATERIAL OBJECT "material.f90")
add_dependencies(MATERIAL MESH)
add_dependencies(MATERIAL MESH CONFIG)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:MATERIAL>)
add_library(DAMASK_HELPERS OBJECT "lattice.f90")
@ -158,7 +163,7 @@ add_library(DAMASK_CPFE OBJECT "CPFEM2.f90")
add_dependencies(DAMASK_CPFE DAMASK_ENGINE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_CPFE>)
if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
if (PROJECT_NAME STREQUAL "DAMASK_spectral")
add_library(SPECTRAL_UTILITIES OBJECT "spectral_utilities.f90")
add_dependencies(SPECTRAL_UTILITIES DAMASK_CPFE)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:SPECTRAL_UTILITIES>)
@ -170,13 +175,13 @@ if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
"spectral_mech_Basic.f90")
add_dependencies(SPECTRAL_SOLVER SPECTRAL_UTILITIES)
list(APPEND OBJECTFILES $<TARGET_OBJECTS:SPECTRAL_SOLVER>)
if(NOT "${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY")
if(NOT CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
add_executable(DAMASK_spectral "DAMASK_spectral.f90" ${OBJECTFILES})
else()
add_library(DAMASK_spectral OBJECT "DAMASK_spectral.f90")
endif()
add_dependencies(DAMASK_spectral SPECTRAL_SOLVER)
elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
add_library(FEM_UTILITIES OBJECT "FEM_utilities.f90")
add_dependencies(FEM_UTILITIES DAMASK_CPFE)

13
src/CPFEM.f90
View File

@ -62,16 +62,18 @@ subroutine CPFEM_initAll(el,ip)
numerics_init
use debug, only: &
debug_init
use config, only: &
config_init
use FEsolving, only: &
FE_init
use math, only: &
math_init
use mesh, only: &
mesh_init
use lattice, only: &
lattice_init
use material, only: &
material_init
use lattice, only: &
lattice_init
use constitutive, only: &
constitutive_init
use crystallite, only: &
@ -93,6 +95,7 @@ subroutine CPFEM_initAll(el,ip)
call IO_init
call numerics_init
call debug_init
call config_init
call math_init
call FE_init
call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip
@ -143,7 +146,8 @@ subroutine CPFEM_init
material_phase, &
homogState, &
phase_plasticity, &
plasticState, &
plasticState
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_F0, &
@ -310,7 +314,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
thermal_type, &
THERMAL_conduction_ID, &
phase_Nsources, &
material_homog, &
material_homog
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_partionedF,&

13
src/CPFEM2.f90
View File

@ -27,16 +27,18 @@ subroutine CPFEM_initAll(el,ip)
numerics_init
use debug, only: &
debug_init
use config, only: &
config_init
use FEsolving, only: &
FE_init
use math, only: &
math_init
use mesh, only: &
mesh_init
use lattice, only: &
lattice_init
use material, only: &
material_init
use lattice, only: &
lattice_init
use constitutive, only: &
constitutive_init
use crystallite, only: &
@ -64,6 +66,7 @@ subroutine CPFEM_initAll(el,ip)
#endif
call numerics_init
call debug_init
call config_init
call math_init
call FE_init
call mesh_init(ip, el) ! pass on coordinates to alter calcMode of first ip
@ -108,7 +111,8 @@ subroutine CPFEM_init
material_phase, &
homogState, &
phase_plasticity, &
plasticState, &
plasticState
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_F0, &
@ -228,7 +232,8 @@ subroutine CPFEM_age()
hydrogenfluxState, &
material_phase, &
phase_plasticity, &
phase_Nsources, &
phase_Nsources
use config, only: &
material_Nhomogenization
use crystallite, only: &
crystallite_partionedF,&

13
src/C_routines.c
View File

@ -11,9 +11,9 @@
int isdirectory_c(const char *dir){
struct stat statbuf;
if(stat(dir, &statbuf) != 0)
return 0;
return S_ISDIR(statbuf.st_mode);
if(stat(dir, &statbuf) != 0) /* error */
return 0; /* return "NO, this is not a directory" */
return S_ISDIR(statbuf.st_mode); /* 1 => is directory, 0 => this is NOT a directory */
}
@ -29,7 +29,7 @@ void getcurrentworkdir_c(char cwd[], int *stat ){
}
void gethostname_c(char hostname[], int *stat ){
void gethostname_c(char hostname[], int *stat){
char hostname_tmp[1024];
if(gethostname(hostname_tmp, sizeof(hostname_tmp)) == 0){
strcpy(hostname,hostname_tmp);
@ -39,3 +39,8 @@ void gethostname_c(char hostname[], int *stat ){
*stat = 1;
}
}
int chdir_c(const char *dir){
return chdir(dir);
}

1
src/DAMASK_marc2014.2.f90
View File

@ -1 +0,0 @@
DAMASK_marc.f90

1
src/DAMASK_marc2014.f90
View File

@ -1 +0,0 @@
DAMASK_marc.f90

1
src/DAMASK_marc2015.f90
View File

@ -1 +0,0 @@
DAMASK_marc.f90

69
src/DAMASK_spectral.f90
View File

@ -12,6 +12,8 @@ program DAMASK_spectral
compiler_version, &
compiler_options
#endif
#include <petsc/finclude/petscsys.h>
use PETScsys
use prec, only: &
pInt, &
pLongInt, &
@ -70,7 +72,6 @@ program DAMASK_spectral
DAMAGE_nonlocal_ID
use spectral_utilities, only: &
utilities_init, &
utilities_destroy, &
tSolutionState, &
tLoadCase, &
cutBack, &
@ -84,11 +85,8 @@ program DAMASK_spectral
use spectral_damage
use spectral_thermal
implicit none
#include <petsc/finclude/petscsys.h>
!--------------------------------------------------------------------------------------------------
! variables related to information from load case and geom file
real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
@ -143,24 +141,17 @@ program DAMASK_spectral
integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742
integer(pInt), parameter :: maxRealOut = maxByteOut/pReal
integer(pLongInt), dimension(2) :: outputIndex
PetscErrorCode :: ierr
integer :: ierr
external :: &
quit, &
MPI_file_open, &
MPI_file_close, &
MPI_file_seek, &
MPI_file_get_position, &
MPI_file_write, &
MPI_abort, &
MPI_finalize, &
MPI_allreduce, &
PETScFinalize
quit
!--------------------------------------------------------------------------------------------------
! init DAMASK (all modules)
call CPFEM_initAll(el = 1_pInt, ip = 1_pInt)
write(6,'(/,a)') ' <<<+- DAMASK_spectral init -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018'
write(6,'(/,a,/)') ' Roters et al., Computational Materials Science, 2018'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
@ -364,8 +355,8 @@ program DAMASK_spectral
select case (loadCases(1)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
call basicPETSc_init
case (DAMASK_spectral_SolverBasic_label)
call basic_init
case (DAMASK_spectral_SolverPolarisation_label)
if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
@ -442,10 +433,9 @@ program DAMASK_spectral
do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output
outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1?
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
call MPI_file_write(resUnit, &
reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), &
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt), &
call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), &
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), &
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write')
enddo
@ -523,8 +513,8 @@ program DAMASK_spectral
select case(loadCases(currentLoadCase)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
call BasicPETSc_forward (&
case (DAMASK_spectral_SolverBasic_label)
call Basic_forward (&
guess,timeinc,timeIncOld,remainingLoadCaseTime, &
deformation_BC = loadCases(currentLoadCase)%deformation, &
stress_BC = loadCases(currentLoadCase)%stress, &
@ -552,8 +542,8 @@ program DAMASK_spectral
select case(loadCases(currentLoadCase)%ID(field))
case(FIELD_MECH_ID)
select case (spectral_solver)
case (DAMASK_spectral_SolverBasicPETSc_label)
solres(field) = BasicPETSC_solution (&
case (DAMASK_spectral_SolverBasic_label)
solres(field) = Basic_solution (&
incInfo,timeinc,timeIncOld, &
stress_BC = loadCases(currentLoadCase)%stress, &
rotation_BC = loadCases(currentLoadCase)%rotation)
@ -634,8 +624,8 @@ program DAMASK_spectral
outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, &
min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt),&
[(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),&
MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write')
enddo
@ -682,22 +672,12 @@ end program DAMASK_spectral
!> stderr. Exit code 3 signals no severe problems, but some increments did not converge
!--------------------------------------------------------------------------------------------------
subroutine quit(stop_id)
#include <petsc/finclude/petscsys.h>
use MPI
use prec, only: &
pInt
use spectral_mech_Basic, only: &
BasicPETSC_destroy
use spectral_mech_Polarisation, only: &
Polarisation_destroy
use spectral_damage, only: &
spectral_damage_destroy
use spectral_thermal, only: &
spectral_thermal_destroy
use spectral_utilities, only: &
utilities_destroy
implicit none
#include <petsc/finclude/petscsys.h>
integer(pInt), intent(in) :: stop_id
integer, dimension(8) :: dateAndTime ! type default integer
integer(pInt) :: error = 0_pInt
@ -705,14 +685,7 @@ subroutine quit(stop_id)
logical :: ErrorInQuit
external :: &
PETScFinalize, &
MPI_finalize
call BasicPETSC_destroy()
call Polarisation_destroy()
call spectral_damage_destroy()
call spectral_thermal_destroy()
call utilities_destroy()
PETScFinalize
call PETScFinalize(ierr)
if (ierr /= 0) write(6,'(a)') ' Error in PETScFinalize'

46
src/IO.f90
View File

@ -560,8 +560,8 @@ function IO_hybridIA(Nast,ODFfileName)
IO_hybridIA = 0.0_pReal ! initialize return value for case of error
write(6,'(/,a,/)',advance='no') ' Using linear ODF file: '//trim(ODFfileName)
write(6,'(/,a)') 'Eisenlohr et al., Computational Materials Science, 42(4):670–678, 2008'
write(6,'(/,a)') 'https://doi.org/10.1016/j.commatsci.2007.09.015'
write(6,'(/,a)') ' Eisenlohr et al., Computational Materials Science, 42(4):670–678, 2008'
write(6,'(a)') ' https://doi.org/10.1016/j.commatsci.2007.09.015'
!--------------------------------------------------------------------------------------------------
@ -900,10 +900,10 @@ function IO_spotTagInPart(fileUnit,part,tag,Nsections)
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
endif foundNextPart
if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier
if (section > 0_pInt) then
chunkPos = IO_stringPos(line)
@ -925,13 +925,10 @@ logical function IO_globalTagInPart(fileUnit,part,tag)
character(len=*),intent(in) :: part, & !< part in which tag is searched for
tag !< tag to search for
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: section
character(len=65536) :: line
IO_globalTagInPart = .false. ! assume to nowhere spot tag
section = 0_pInt
line =''
rewind(fileUnit)
@ -942,16 +939,20 @@ logical function IO_globalTagInPart(fileUnit,part,tag)
do while (trim(line) /= IO_EOF)
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier
if (section == 0_pInt) then
chunkPos = IO_stringPos(line)
if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match
IO_globalTagInPart = .true.
endif
endif foundNextPart
foundFirstSection: if (IO_getTag(line,'[',']') /= '') then
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif foundFirstSection
chunkPos = IO_stringPos(line)
match: if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) then
IO_globalTagInPart = .true.
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif match
enddo
end function IO_globalTagInPart
@ -981,6 +982,10 @@ pure function IO_stringPos(string)
if ( string(left:left) == '#' ) exit
IO_stringPos = [IO_stringPos,int(left, pInt), int(right, pInt)]
IO_stringPos(1) = IO_stringPos(1)+1_pInt
endOfString: if (right < left) then
IO_stringPos(IO_stringPos(1)*2+1) = len_trim(string)
exit
endif endOfString
enddo
end function IO_stringPos
@ -1545,6 +1550,17 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
case (136_pInt)
msg = 'zero entry on stiffness diagonal for transformed phase'
!--------------------------------------------------------------------------------------------------
! errors related to the parsing of material.config
case (140_pInt)
msg = 'key not found'
case (141_pInt)
msg = 'number of chunks in string differs'
case (142_pInt)
msg = 'empty list'
case (143_pInt)
msg = 'no value found for key'
!--------------------------------------------------------------------------------------------------
! material error messages and related messages in mesh
case (150_pInt)

1
src/commercialFEM_fileList.f90
View File

@ -6,6 +6,7 @@
#include "IO.f90"
#include "numerics.f90"
#include "debug.f90"
#include "config.f90"
#include "math.f90"
#include "FEsolving.f90"
#include "mesh.f90"

692
src/config.f90 Normal file
View File

@ -0,0 +1,692 @@
!--------------------------------------------------------------------------------------------------
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Reads in the material configuration from file
!> @details Reads the material configuration file, where solverJobName.materialConfig takes
!! precedence over material.config. Stores the raw strings and the positions of delimiters for the
!! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture'
!--------------------------------------------------------------------------------------------------
module config
use prec, only: &
pReal, &
pInt
implicit none
private
type, private :: tPartitionedString
character(len=:), allocatable :: val
integer(pInt), dimension(:), allocatable :: pos
end type tPartitionedString
type, public :: tPartitionedStringList
type(tPartitionedString) :: string
type(tPartitionedStringList), pointer :: next => null()
contains
procedure :: add => add
procedure :: show => show
procedure :: free => free
procedure :: keyExists => keyExists
procedure :: countKeys => countKeys
procedure :: getFloat => getFloat
procedure :: getInt => getInt
procedure :: getString => getString
procedure :: getFloats => getFloats
procedure :: getInts => getInts
procedure :: getStrings => getStrings
end type tPartitionedStringList
type(tPartitionedStringList), public :: emptyList
type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX?
config_phase, &
config_microstructure, &
config_homogenization, &
config_texture, &
config_crystallite
character(len=64), dimension(:), allocatable, public, protected :: &
phase_name, & !< name of each phase
homogenization_name, & !< name of each homogenization
crystallite_name, & !< name of each crystallite setting
microstructure_name, & !< name of each microstructure
texture_name !< name of each texture
! ToDo: make private, no one needs to know that
character(len=*), parameter, public :: &
MATERIAL_partHomogenization = 'homogenization', & !< keyword for homogenization part
MATERIAL_partCrystallite = 'crystallite', & !< keyword for crystallite part
MATERIAL_partPhase = 'phase', & !< keyword for phase part
MATERIAL_partMicrostructure = 'microstructure' !< keyword for microstructure part
character(len=*), parameter, private :: &
MATERIAL_partTexture = 'texture' !< keyword for texture part
! ToDo: Remove, use size(config_phase) etc
integer(pInt), public, protected :: &
material_Nphase, & !< number of phases
material_Nhomogenization, & !< number of homogenizations
material_Nmicrostructure, & !< number of microstructures
material_Ncrystallite !< number of crystallite settings
! ToDo: make private, no one needs to know that
character(len=*), parameter, public :: &
MATERIAL_configFile = 'material.config', & !< generic name for material configuration file
MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file
public :: &
config_init, &
config_deallocate
contains
!--------------------------------------------------------------------------------------------------
!> @brief reads material.config and stores its content per part
!--------------------------------------------------------------------------------------------------
subroutine config_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO, only: &
IO_error, &
IO_open_file, &
IO_read, &
IO_lc, &
IO_open_jobFile_stat, &
IO_getTag, &
IO_timeStamp, &
IO_EOF
use debug, only: &
debug_level, &
debug_material, &
debug_levelBasic
implicit none
integer(pInt), parameter :: FILEUNIT = 200_pInt
integer(pInt) :: myDebug
character(len=65536) :: &
line, &
part
write(6,'(/,a)') ' <<<+- config init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
myDebug = debug_level(debug_material)
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file
rewind(fileUnit)
line = '' ! to have it initialized
do while (trim(line) /= IO_EOF)
part = IO_lc(IO_getTag(line,'<','>'))
select case (trim(part))
case (trim(material_partPhase))
call parseFile(line,phase_name,config_phase,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
case (trim(material_partMicrostructure))
call parseFile(line,microstructure_name,config_microstructure,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
case (trim(material_partCrystallite))
call parseFile(line,crystallite_name,config_crystallite,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
case (trim(material_partHomogenization))
call parseFile(line,homogenization_name,config_homogenization,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
case (trim(material_partTexture))
call parseFile(line,texture_name,config_texture,FILEUNIT)
if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
case default
line = IO_read(fileUnit)
end select
enddo
material_Nhomogenization = size(config_homogenization)
if (material_Nhomogenization < 1_pInt) call IO_error(160_pInt,ext_msg=material_partHomogenization)
material_Nmicrostructure = size(config_microstructure)
if (material_Nmicrostructure < 1_pInt) call IO_error(160_pInt,ext_msg=material_partMicrostructure)
material_Ncrystallite = size(config_crystallite)
if (material_Ncrystallite < 1_pInt) call IO_error(160_pInt,ext_msg=material_partCrystallite)
material_Nphase = size(config_phase)
if (material_Nphase < 1_pInt) call IO_error(160_pInt,ext_msg=material_partPhase)
if (size(config_texture) < 1_pInt) call IO_error(160_pInt,ext_msg=material_partTexture)
end subroutine config_init
!--------------------------------------------------------------------------------------------------
!> @brief parses the material.config file
!--------------------------------------------------------------------------------------------------
subroutine parseFile(line,&
sectionNames,part,fileUnit)
use IO, only: &
IO_read, &
IO_error, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringValue, &
IO_stringPos, &
IO_EOF
implicit none
integer(pInt), intent(in) :: fileUnit
character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames
type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part
character(len=65536),intent(out) :: line
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: s
character(len=65536) :: devNull
character(len=64) :: tag
logical :: echo
echo = .false.
allocate(part(0))
s = 0_pInt
do while (trim(line) /= IO_EOF) ! read through sections of material part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
foundNextPart: if (IO_getTag(line,'<','>') /= '') then
devNull = IO_read(fileUnit, .true.) ! reset IO_read to close any recursively included files
exit
endif foundNextPart
nextSection: if (IO_getTag(line,'[',']') /= '') then
s = s + 1_pInt
part = [part, emptyList]
tag = IO_getTag(line,'[',']')
GfortranBug86033: if (.not. allocated(sectionNames)) then
allocate(sectionNames(1),source=tag)
else GfortranBug86033
sectionNames = [sectionNames,tag]
endif GfortranBug86033
cycle
endif nextSection
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key
inSection: if (s > 0_pInt) then
call part(s)%add(IO_lc(trim(line)))
else inSection
echo = (trim(tag) == '/echo/')
endif inSection
enddo
if (echo) then
do s = 1, size(sectionNames)
call part(s)%show()
end do
end if
end subroutine parseFile
subroutine config_deallocate(what)
use IO, only: &
IO_error
implicit none
character(len=*), intent(in) :: what
integer(pInt) :: i
select case(what)
case('material.config/phase')
do i=1, size(config_phase)
call config_phase(i)%free
enddo
deallocate(config_phase)
case('material.config/microstructure')
do i=1, size(config_microstructure)
call config_microstructure(i)%free
enddo
deallocate(config_microstructure)
case('material.config/crystallite')
do i=1, size(config_crystallite)
call config_crystallite(i)%free
enddo
deallocate(config_crystallite)
case('material.config/homogenization')
do i=1, size(config_homogenization)
call config_homogenization(i)%free
enddo
deallocate(config_homogenization)
case('material.config/texture')
do i=1, size(config_texture)
call config_texture(i)%free
enddo
deallocate(config_texture)
case default
call IO_error(0_pInt,ext_msg='config_deallocate')
end select
end subroutine config_deallocate
!--------------------------------------------------------------------------------------------------
!> @brief add element
!> @details Adds a string together with the start/end position of chunks in this string. The new
!! element is added at the end of the list. Empty strings are not added. All strings are converted
!! to lower case
!--------------------------------------------------------------------------------------------------
subroutine add(this,string)
use IO, only: &
IO_isBlank, &
IO_lc, &
IO_stringPos
implicit none
class(tPartitionedStringList), target, intent(in) :: this
character(len=*), intent(in) :: string
type(tPartitionedStringList), pointer :: new, item
if (IO_isBlank(string)) return
allocate(new)
new%string%val = IO_lc (trim(string))
new%string%pos = IO_stringPos(trim(string))
item => this
do while (associated(item%next))
item => item%next
enddo
item%next => new
end subroutine add
!--------------------------------------------------------------------------------------------------
!> @brief prints all elements
!> @details Strings are printed in order of insertion (FIFO)
!--------------------------------------------------------------------------------------------------
subroutine show(this)
implicit none
class(tPartitionedStringList) :: this
type(tPartitionedStringList), pointer :: item
item => this%next
do while (associated(item))
write(6,'(a)') trim(item%string%val)
item => item%next
end do
end subroutine show
!--------------------------------------------------------------------------------------------------
!> @brief cleans entire list
!> @details list head is remains alive
!--------------------------------------------------------------------------------------------------
subroutine free(this)
implicit none
class(tPartitionedStringList), target, intent(in) :: this
type(tPartitionedStringList), pointer :: new, item
if (.not. associated(this%next)) return
item => this%next
do while (associated(item%next))
new => item
deallocate(item)
item => new%next
enddo
deallocate(item)
end subroutine free
!--------------------------------------------------------------------------------------------------
!> @brief reports wether a given key (string value at first position) exists in the list
!--------------------------------------------------------------------------------------------------
logical function keyExists(this,key)
use IO, only: &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item
keyExists = .false.
item => this%next
do while (associated(item) .and. .not. keyExists)
keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
item => item%next
end do
end function keyExists
!--------------------------------------------------------------------------------------------------
!> @brief count number of key appearances
!> @details traverses list and counts each occurrence of specified key
!--------------------------------------------------------------------------------------------------
integer(pInt) function countKeys(this,key)
use IO, only: &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
type(tPartitionedStringList), pointer :: item
countKeys = 0_pInt
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) &
countKeys = countKeys + 1_pInt
item => item%next
end do
end function countKeys
!--------------------------------------------------------------------------------------------------
!> @brief gets float value of for a given key from a linked list
!> @details gets the last value if the key occurs more than once. If key is not found exits with
!! error unless default is given
!--------------------------------------------------------------------------------------------------
real(pReal) function getFloat(this,key,defaultVal)
use IO, only : &
IO_error, &
IO_stringValue, &
IO_FloatValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
logical :: found
found = present(defaultVal)
if (found) getFloat = defaultVal
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
getFloat = IO_FloatValue(item%string%val,item%string%pos,2)
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getFloat
!--------------------------------------------------------------------------------------------------
!> @brief gets integer value of for a given key from a linked list
!> @details gets the last value if the key occurs more than once. If key is not found exits with
!! error unless default is given
!--------------------------------------------------------------------------------------------------
integer(pInt) function getInt(this,key,defaultVal)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_IntValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), intent(in), optional :: defaultVal
type(tPartitionedStringList), pointer :: item
logical :: found
found = present(defaultVal)
if (found) getInt = defaultVal
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
getInt = IO_IntValue(item%string%val,item%string%pos,2)
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getInt
!--------------------------------------------------------------------------------------------------
!> @brief gets string value of for a given key from a linked list
!> @details gets the last value if the key occurs more than once. If key is not found exits with
!! error unless default is given. If raw is true, the the complete string is returned, otherwise
!! the individual chunks are returned
!--------------------------------------------------------------------------------------------------
character(len=65536) function getString(this,key,defaultVal,raw)
use IO, only: &
IO_error, &
IO_stringValue
implicit none
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536), intent(in), optional :: defaultVal
logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item
logical :: found, &
whole
whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting
found = present(defaultVal)
if (found) then
getString = trim(defaultVal)
if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString')
endif
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
if (whole) then
getString = trim(item%string%val(item%string%pos(4):)) ! raw string starting a second chunk
else
getString = IO_StringValue(item%string%val,item%string%pos,2)
endif
endif
item => item%next
end do
if (.not. found) call IO_error(140_pInt,ext_msg=key)
end function getString
!--------------------------------------------------------------------------------------------------
!> @brief gets array of float values of for a given key from a linked list
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getFloats(this,key,defaultVal,requiredShape)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_FloatValue
implicit none
real(pReal), dimension(:), allocatable :: getFloats
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
real(pReal), dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
found = .false.
allocate(getFloats(0))
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (.not. cumulative) getFloats = [real(pReal)::]
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
do i = 2_pInt, item%string%pos(1)
getFloats = [getFloats,IO_FloatValue(item%string%val,item%string%pos,i)]
enddo
endif
item => item%next
end do
if (.not. found) then
if (present(defaultVal)) then; getFloats = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
endif
end function getFloats
!--------------------------------------------------------------------------------------------------
!> @brief gets array of integer values of for a given key from a linked list
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!--------------------------------------------------------------------------------------------------
function getInts(this,key,defaultVal,requiredShape)
use IO, only: &
IO_error, &
IO_stringValue, &
IO_IntValue
implicit none
integer(pInt), dimension(:), allocatable :: getInts
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
integer(pInt), dimension(:), intent(in), optional :: defaultVal, &
requiredShape
type(tPartitionedStringList), pointer :: item
integer(pInt) :: i
logical :: found, &
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
found = .false.
allocate(getInts(0))
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (.not. cumulative) getInts = [integer(pInt)::]
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
do i = 2_pInt, item%string%pos(1)
getInts = [getInts,IO_IntValue(item%string%val,item%string%pos,i)]
enddo
endif
item => item%next
end do
if (.not. found) then
if (present(defaultVal)) then; getInts = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
endif
end function getInts
!--------------------------------------------------------------------------------------------------
!> @brief gets array of string values of for a given key from a linked list
!> @details for cumulative keys, "()", values from all occurrences are return. Otherwise only all
!! values from the last occurrence. If key is not found exits with error unless default is given.
!! If raw is true, the the complete string is returned, otherwise the individual chunks are returned
!--------------------------------------------------------------------------------------------------
function getStrings(this,key,defaultVal,requiredShape,raw)
use IO, only: &
IO_error, &
IO_StringValue
implicit none
character(len=65536),dimension(:), allocatable :: getStrings
class(tPartitionedStringList), intent(in) :: this
character(len=*), intent(in) :: key
character(len=65536),dimension(:), intent(in), optional :: defaultVal
integer(pInt), dimension(:), intent(in), optional :: requiredShape
logical, intent(in), optional :: raw
type(tPartitionedStringList), pointer :: item
character(len=65536) :: str
integer(pInt) :: i
logical :: found, &
whole, &
cumulative
cumulative = (key(1:1) == '(' .and. key(len_trim(key):len_trim(key)) == ')')
whole = merge(raw,.false.,present(raw))
found = .false.
item => this%next
do while (associated(item))
if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then
found = .true.
if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings)
if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key)
notAllocated: if (.not. allocated(getStrings)) then
if (whole) then
str = item%string%val(item%string%pos(4):)
getStrings = [str]
else
str = IO_StringValue(item%string%val,item%string%pos,2_pInt)
allocate(getStrings(1),source=str)
do i=3_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
enddo
endif
else notAllocated
if (whole) then
getStrings = [getStrings,str]
else
do i=2_pInt,item%string%pos(1)
str = IO_StringValue(item%string%val,item%string%pos,i)
getStrings = [getStrings,str]
enddo
endif
endif notAllocated
endif
item => item%next
end do
if (.not. found) then
if (present(defaultVal)) then; getStrings = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
endif
end function getStrings
end module config

64
src/constitutive.f90
View File

@ -57,14 +57,17 @@ subroutine constitutive_init()
IO_write_jobFile, &
IO_write_jobIntFile, &
IO_timeStamp
use config, only: &
config_deallocate
use mesh, only: &
FE_geomtype
use material, only: &
material_phase, &
use config, only: &
material_Nphase, &
material_localFileExt, &
material_configFile, &
phase_name, &
material_configFile
use material, only: &
material_phase, &
phase_plasticity, &
phase_plasticityInstance, &
phase_Nsources, &
@ -143,7 +146,6 @@ subroutine constitutive_init()
ins !< instance of plasticity/source
integer(pInt), dimension(:,:), pointer :: thisSize
integer(pInt), dimension(:) , pointer :: thisNoutput
character(len=64), dimension(:,:), pointer :: thisOutput
character(len=32) :: outputName !< name of output, intermediate fix until HDF5 output is ready
logical :: knownPlasticity, knownSource, nonlocalConstitutionPresent
@ -157,7 +159,7 @@ subroutine constitutive_init()
!--------------------------------------------------------------------------------------------------
! parse plasticities from config file
if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init
if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init(FILEUNIT)
if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init
if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT)
if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT)
if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT)
@ -190,6 +192,8 @@ subroutine constitutive_init()
if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT)
close(FILEUNIT)
call config_deallocate('material.config/phase')
write(6,'(/,a)') ' <<<+- constitutive init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
@ -205,37 +209,30 @@ subroutine constitutive_init()
plasticityType: select case(phase_plasticity(p))
case (PLASTICITY_NONE_ID) plasticityType
outputName = PLASTICITY_NONE_label
thisNoutput => null()
thisOutput => null()
thisSize => null()
case (PLASTICITY_ISOTROPIC_ID) plasticityType
outputName = PLASTICITY_ISOTROPIC_label
thisNoutput => plastic_isotropic_Noutput
thisOutput => plastic_isotropic_output
thisSize => plastic_isotropic_sizePostResult
case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType
outputName = PLASTICITY_PHENOPOWERLAW_label
thisNoutput => plastic_phenopowerlaw_Noutput
thisOutput => plastic_phenopowerlaw_output
thisSize => plastic_phenopowerlaw_sizePostResult
case (PLASTICITY_KINEHARDENING_ID) plasticityType
outputName = PLASTICITY_KINEHARDENING_label
thisNoutput => plastic_kinehardening_Noutput
thisOutput => plastic_kinehardening_output
thisSize => plastic_kinehardening_sizePostResult
case (PLASTICITY_DISLOTWIN_ID) plasticityType
outputName = PLASTICITY_DISLOTWIN_label
thisNoutput => plastic_dislotwin_Noutput
thisOutput => plastic_dislotwin_output
thisSize => plastic_dislotwin_sizePostResult
case (PLASTICITY_DISLOUCLA_ID) plasticityType
outputName = PLASTICITY_DISLOUCLA_label
thisNoutput => plastic_disloucla_Noutput
thisOutput => plastic_disloucla_output
thisSize => plastic_disloucla_sizePostResult
case (PLASTICITY_NONLOCAL_ID) plasticityType
outputName = PLASTICITY_NONLOCAL_label
thisNoutput => plastic_nonlocal_Noutput
thisOutput => plastic_nonlocal_output
thisSize => plastic_nonlocal_sizePostResult
case default plasticityType
@ -246,8 +243,9 @@ subroutine constitutive_init()
write(FILEUNIT,'(a)') '(plasticity)'//char(9)//trim(outputName)
if (phase_plasticity(p) /= PLASTICITY_NONE_ID) then
OutputPlasticityLoop: do o = 1_pInt,thisNoutput(ins)
write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins)
OutputPlasticityLoop: do o = 1_pInt,size(thisOutput(:,ins))
if(len(trim(thisOutput(o,ins))) > 0_pInt) &
write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins)
enddo OutputPlasticityLoop
endif
endif
@ -257,55 +255,46 @@ subroutine constitutive_init()
case (SOURCE_thermal_dissipation_ID) sourceType
ins = source_thermal_dissipation_instance(p)
outputName = SOURCE_thermal_dissipation_label
thisNoutput => source_thermal_dissipation_Noutput
thisOutput => source_thermal_dissipation_output
thisSize => source_thermal_dissipation_sizePostResult
case (SOURCE_thermal_externalheat_ID) sourceType
ins = source_thermal_externalheat_instance(p)
outputName = SOURCE_thermal_externalheat_label
thisNoutput => source_thermal_externalheat_Noutput
thisOutput => source_thermal_externalheat_output
thisSize => source_thermal_externalheat_sizePostResult
case (SOURCE_damage_isoBrittle_ID) sourceType
ins = source_damage_isoBrittle_instance(p)
outputName = SOURCE_damage_isoBrittle_label
thisNoutput => source_damage_isoBrittle_Noutput
thisOutput => source_damage_isoBrittle_output
thisSize => source_damage_isoBrittle_sizePostResult
case (SOURCE_damage_isoDuctile_ID) sourceType
ins = source_damage_isoDuctile_instance(p)
outputName = SOURCE_damage_isoDuctile_label
thisNoutput => source_damage_isoDuctile_Noutput
thisOutput => source_damage_isoDuctile_output
thisSize => source_damage_isoDuctile_sizePostResult
case (SOURCE_damage_anisoBrittle_ID) sourceType
ins = source_damage_anisoBrittle_instance(p)
outputName = SOURCE_damage_anisoBrittle_label
thisNoutput => source_damage_anisoBrittle_Noutput
thisOutput => source_damage_anisoBrittle_output
thisSize => source_damage_anisoBrittle_sizePostResult
case (SOURCE_damage_anisoDuctile_ID) sourceType
ins = source_damage_anisoDuctile_instance(p)
outputName = SOURCE_damage_anisoDuctile_label
thisNoutput => source_damage_anisoDuctile_Noutput
thisOutput => source_damage_anisoDuctile_output
thisSize => source_damage_anisoDuctile_sizePostResult
case (SOURCE_vacancy_phenoplasticity_ID) sourceType
ins = source_vacancy_phenoplasticity_instance(p)
outputName = SOURCE_vacancy_phenoplasticity_label
thisNoutput => source_vacancy_phenoplasticity_Noutput
thisOutput => source_vacancy_phenoplasticity_output
thisSize => source_vacancy_phenoplasticity_sizePostResult
case (SOURCE_vacancy_irradiation_ID) sourceType
ins = source_vacancy_irradiation_instance(p)
outputName = SOURCE_vacancy_irradiation_label
thisNoutput => source_vacancy_irradiation_Noutput
thisOutput => source_vacancy_irradiation_output
thisSize => source_vacancy_irradiation_sizePostResult
case (SOURCE_vacancy_thermalfluc_ID) sourceType
ins = source_vacancy_thermalfluc_instance(p)
outputName = SOURCE_vacancy_thermalfluc_label
thisNoutput => source_vacancy_thermalfluc_Noutput
thisOutput => source_vacancy_thermalfluc_output
thisSize => source_vacancy_thermalfluc_sizePostResult
case default sourceType
@ -313,8 +302,9 @@ subroutine constitutive_init()
end select sourceType
if (knownSource) then
write(FILEUNIT,'(a)') '(source)'//char(9)//trim(outputName)
OutputSourceLoop: do o = 1_pInt,thisNoutput(ins)
write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins)
OutputSourceLoop: do o = 1_pInt,size(thisOutput(:,ins))
if(len(trim(thisOutput(o,ins))) > 0_pInt) &
write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,ins)
enddo OutputSourceLoop
endif
enddo SourceLoop
@ -350,30 +340,6 @@ subroutine constitutive_init()
enddo PhaseLoop2
#ifdef TODO
!--------------------------------------------------------------------------------------------------
! report
constitutive_maxSizeState = maxval(constitutive_sizeState)
constitutive_plasticity_maxSizeDotState = maxval(constitutive_sizeDotState)
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) then
write(6,'(a32,1x,7(i8,1x))') 'constitutive_state0: ', shape(constitutive_state0)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_partionedState0: ', shape(constitutive_partionedState0)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_subState0: ', shape(constitutive_subState0)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_state: ', shape(constitutive_state)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_aTolState: ', shape(constitutive_aTolState)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_dotState: ', shape(constitutive_dotState)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_deltaState: ', shape(constitutive_deltaState)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_sizeState: ', shape(constitutive_sizeState)
write(6,'(a32,1x,7(i8,1x))') 'constitutive_sizeDotState: ', shape(constitutive_sizeDotState)
write(6,'(a32,1x,7(i8,1x),/)') 'constitutive_sizePostResults: ', shape(constitutive_sizePostResults)
write(6,'(a32,1x,7(i8,1x))') 'maxSizeState: ', constitutive_maxSizeState
write(6,'(a32,1x,7(i8,1x))') 'maxSizeDotState: ', constitutive_plasticity_maxSizeDotState
write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', constitutive_plasticity_maxSizePostResults
endif
flush(6)
#endif
end subroutine constitutive_init

232
src/crystallite.f90
View File

@ -155,7 +155,6 @@ subroutine crystallite_init
math_I3, &
math_EulerToR, &
math_inv33, &
math_transpose33, &
math_mul33xx33, &
math_mul33x33
use FEsolving, only: &
@ -167,28 +166,22 @@ subroutine crystallite_init
mesh_maxNips, &
mesh_maxNipNeighbors
use IO, only: &
IO_read, &
IO_timeStamp, &
IO_open_jobFile_stat, &
IO_open_file, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_write_jobFile, &
IO_error, &
IO_EOF
IO_error
use material
use config, only: &
config_crystallite, &
crystallite_name, &
config_deallocate
use constitutive, only: &
constitutive_initialFi, &
constitutive_microstructure ! derived (shortcut) quantities of given state
implicit none
integer(pInt), parameter :: &
FILEUNIT = 200_pInt
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt), parameter :: FILEUNIT=434_pInt
integer(pInt) :: &
c, & !< counter in integration point component loop
i, & !< counter in integration point loop
@ -200,12 +193,11 @@ subroutine crystallite_init
eMax, & !< maximum number of elements
nMax, & !< maximum number of ip neighbors
myNcomponents, & !< number of components at current IP
section = 0_pInt, &
mySize
character(len=65536), dimension(:), allocatable :: str
character(len=65536) :: &
tag = '', &
line= ''
tag = ''
write(6,'(/,a)') ' <<<+- crystallite init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -270,94 +262,77 @@ subroutine crystallite_init
allocate(crystallite_clearToCutback(iMax,eMax), source=.true.)
allocate(crystallite_neighborEnforcedCutback(iMax,eMax), source=.false.)
allocate(crystallite_output(maxval(crystallite_Noutput), &
material_Ncrystallite)) ; crystallite_output = ''
size(config_crystallite))) ; crystallite_output = ''
allocate(crystallite_outputID(maxval(crystallite_Noutput), &
material_Ncrystallite), source=undefined_ID)
allocate(crystallite_sizePostResults(material_Ncrystallite),source=0_pInt)
size(config_crystallite)), source=undefined_ID)
allocate(crystallite_sizePostResults(size(config_crystallite)),source=0_pInt)
allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), &
material_Ncrystallite), source=0_pInt)
size(config_crystallite)), source=0_pInt)
if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present...
call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partCrystallite) ! wind forward to <crystallite>
line = IO_read(FILEUNIT)
enddo
do while (trim(line) /= IO_EOF) ! read through sections of crystallite part
line = IO_read(FILEUNIT)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(FILEUNIT, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next section
section = section + 1_pInt
o = 0_pInt ! reset output counter
cycle ! skip to next line
endif
if (section > 0_pInt) then
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
o = o + 1_pInt
crystallite_output(o,section) = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
outputName: select case(crystallite_output(o,section))
do c = 1_pInt, size(config_crystallite)
#if defined(__GFORTRAN__)
str = ['GfortranBug86277']
str = config_crystallite(c)%getStrings('(output)',defaultVal=str)
if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
#else
str = config_crystallite(c)%getStrings('(output)',defaultVal=[character(len=65536)::])
#endif
do o = 1_pInt, size(str)
crystallite_output(o,c) = str(o)
outputName: select case(str(o))
case ('phase') outputName
crystallite_outputID(o,section) = phase_ID
crystallite_outputID(o,c) = phase_ID
case ('texture') outputName
crystallite_outputID(o,section) = texture_ID
crystallite_outputID(o,c) = texture_ID
case ('volume') outputName
crystallite_outputID(o,section) = volume_ID
crystallite_outputID(o,c) = volume_ID
case ('grainrotationx') outputName
crystallite_outputID(o,section) = grainrotationx_ID
crystallite_outputID(o,c) = grainrotationx_ID
case ('grainrotationy') outputName
crystallite_outputID(o,section) = grainrotationy_ID
crystallite_outputID(o,c) = grainrotationy_ID
case ('grainrotationz') outputName
crystallite_outputID(o,section) = grainrotationx_ID
crystallite_outputID(o,c) = grainrotationx_ID
case ('orientation') outputName
crystallite_outputID(o,section) = orientation_ID
crystallite_outputID(o,c) = orientation_ID
case ('grainrotation') outputName
crystallite_outputID(o,section) = grainrotation_ID
crystallite_outputID(o,c) = grainrotation_ID
case ('eulerangles') outputName
crystallite_outputID(o,section) = eulerangles_ID
crystallite_outputID(o,c) = eulerangles_ID
case ('defgrad','f') outputName
crystallite_outputID(o,section) = defgrad_ID
crystallite_outputID(o,c) = defgrad_ID
case ('fe') outputName
crystallite_outputID(o,section) = fe_ID
crystallite_outputID(o,c) = fe_ID
case ('fp') outputName
crystallite_outputID(o,section) = fp_ID
crystallite_outputID(o,c) = fp_ID
case ('fi') outputName
crystallite_outputID(o,section) = fi_ID
crystallite_outputID(o,c) = fi_ID
case ('lp') outputName
crystallite_outputID(o,section) = lp_ID
crystallite_outputID(o,c) = lp_ID
case ('li') outputName
crystallite_outputID(o,section) = li_ID
crystallite_outputID(o,c) = li_ID
case ('e') outputName
crystallite_outputID(o,section) = e_ID
crystallite_outputID(o,c) = e_ID
case ('ee') outputName
crystallite_outputID(o,section) = ee_ID
crystallite_outputID(o,c) = ee_ID
case ('p','firstpiola','1stpiola') outputName
crystallite_outputID(o,section) = p_ID
crystallite_outputID(o,c) = p_ID
case ('s','tstar','secondpiola','2ndpiola') outputName
crystallite_outputID(o,section) = s_ID
crystallite_outputID(o,c) = s_ID
case ('elasmatrix') outputName
crystallite_outputID(o,section) = elasmatrix_ID
crystallite_outputID(o,c) = elasmatrix_ID
case ('neighboringip') outputName
crystallite_outputID(o,section) = neighboringip_ID
crystallite_outputID(o,c) = neighboringip_ID
case ('neighboringelement') outputName
crystallite_outputID(o,section) = neighboringelement_ID
crystallite_outputID(o,c) = neighboringelement_ID
case default outputName
call IO_error(105_pInt,ext_msg=IO_stringValue(line,chunkPos,2_pInt)//' (Crystallite)')
call IO_error(105_pInt,ext_msg=tag//' (Crystallite)')
end select outputName
end select
endif
enddo
enddo
close(FILEUNIT)
do r = 1_pInt,material_Ncrystallite
do r = 1_pInt,size(config_crystallite)
do o = 1_pInt,crystallite_Noutput(r)
select case(crystallite_outputID(o,r))
case(phase_ID,texture_ID,volume_ID,grainrotationx_ID,grainrotationy_ID,grainrotationz_ID)
@ -389,7 +364,7 @@ subroutine crystallite_init
if (worldrank == 0_pInt) then
call IO_write_jobFile(FILEUNIT,'outputCrystallite')
do r = 1_pInt,material_Ncrystallite
do r = 1_pInt,size(config_crystallite)
if (any(microstructure_crystallite(mesh_element(4,:)) == r)) then
write(FILEUNIT,'(/,a,/)') '['//trim(crystallite_name(r))//']'
do o = 1_pInt,crystallite_Noutput(r)
@ -401,6 +376,8 @@ subroutine crystallite_init
close(FILEUNIT)
endif
call config_deallocate('material.config/crystallite')
!--------------------------------------------------------------------------------------------------
! initialize
!$OMP PARALLEL DO PRIVATE(myNcomponents)
@ -536,7 +513,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
use math, only: &
math_inv33, &
math_identity2nd, &
math_transpose33, &
math_mul33x33, &
math_mul66x6, &
math_Mandel6to33, &
@ -615,17 +591,17 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
write(6,'(/,a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> boundary values at el ip ipc ', &
debug_e,'(',mesh_element(1,debug_e), ')',debug_i, debug_g
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F ', &
math_transpose33(crystallite_partionedF(1:3,1:3,debug_g,debug_i,debug_e))
transpose(crystallite_partionedF(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> F0 ', &
math_transpose33(crystallite_partionedF0(1:3,1:3,debug_g,debug_i,debug_e))
transpose(crystallite_partionedF0(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp0', &
math_transpose33(crystallite_partionedFp0(1:3,1:3,debug_g,debug_i,debug_e))
transpose(crystallite_partionedFp0(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fi0', &
math_transpose33(crystallite_partionedFi0(1:3,1:3,debug_g,debug_i,debug_e))
transpose(crystallite_partionedFi0(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Lp0', &
math_transpose33(crystallite_partionedLp0(1:3,1:3,debug_g,debug_i,debug_e))
transpose(crystallite_partionedLp0(1:3,1:3,debug_g,debug_i,debug_e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Li0', &
math_transpose33(crystallite_partionedLi0(1:3,1:3,debug_g,debug_i,debug_e))
transpose(crystallite_partionedLi0(1:3,1:3,debug_g,debug_i,debug_e))
endif
!--------------------------------------------------------------------------------------------------
@ -1104,15 +1080,15 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
.or. .not. iand(debug_level(debug_crystallite),debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CRYST >> central solution of cryst_StressAndTangent at el ip ipc ',e,i,c
write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CRYST >> P / MPa', &
math_transpose33(crystallite_P(1:3,1:3,c,i,e))*1.0e-6_pReal
transpose(crystallite_P(1:3,1:3,c,i,e))*1.0e-6_pReal
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fp', &
math_transpose33(crystallite_Fp(1:3,1:3,c,i,e))
transpose(crystallite_Fp(1:3,1:3,c,i,e))
write(6,'(a,/,3(12x,3(f14.9,1x)/))') '<< CRYST >> Fi', &
math_transpose33(crystallite_Fi(1:3,1:3,c,i,e))
transpose(crystallite_Fi(1:3,1:3,c,i,e))
write(6,'(a,/,3(12x,3(f14.9,1x)/),/)') '<< CRYST >> Lp', &
math_transpose33(crystallite_Lp(1:3,1:3,c,i,e))
transpose(crystallite_Lp(1:3,1:3,c,i,e))
write(6,'(a,/,3(12x,3(f14.9,1x)/),/)') '<< CRYST >> Li', &
math_transpose33(crystallite_Li(1:3,1:3,c,i,e))
transpose(crystallite_Li(1:3,1:3,c,i,e))
flush(6)
endif
enddo
@ -1163,7 +1139,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
crystallite_Fi(1:3,1:3,c,i,e),c,i,e) ! call constitutive law to calculate Lp tangent in lattice configuration
dLpdS = math_mul3333xx3333(dLpdFi,dFidS) + dLpdS
temp_33 = math_transpose33(math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
temp_33 = transpose(math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
crystallite_invFi(1:3,1:3,c,i,e)))
rhs_3333 = 0.0_pReal
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
@ -1205,12 +1181,12 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
crystallite_dPdF(1:3,1:3,1:3,1:3,c,i,e) = 0.0_pReal
temp_33 = math_mul33x33(crystallite_invFp(1:3,1:3,c,i,e), &
math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), &
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e))))
transpose(crystallite_invFp(1:3,1:3,c,i,e))))
forall(p=1_pInt:3_pInt) &
crystallite_dPdF(p,1:3,p,1:3,c,i,e) = math_transpose33(temp_33)
crystallite_dPdF(p,1:3,p,1:3,c,i,e) = transpose(temp_33)
temp_33 = math_mul33x33(math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)), &
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e)))
transpose(crystallite_invFp(1:3,1:3,c,i,e)))
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e),dFpinvdF(1:3,1:3,p,o)),temp_33)
@ -1220,14 +1196,14 @@ subroutine crystallite_stressAndItsTangent(updateJaco)
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
math_mul33x33(math_mul33x33(temp_33,dSdF(1:3,1:3,p,o)), &
math_transpose33(crystallite_invFp(1:3,1:3,c,i,e)))
transpose(crystallite_invFp(1:3,1:3,c,i,e)))
temp_33 = math_mul33x33(math_mul33x33(crystallite_subF(1:3,1:3,c,i,e), &
crystallite_invFp(1:3,1:3,c,i,e)), &
math_Mandel6to33(crystallite_Tstar_v(1:6,c,i,e)))
forall(p=1_pInt:3_pInt, o=1_pInt:3_pInt) &
crystallite_dPdF(1:3,1:3,p,o,c,i,e) = crystallite_dPdF(1:3,1:3,p,o,c,i,e) + &
math_mul33x33(temp_33,math_transpose33(dFpinvdF(1:3,1:3,p,o)))
math_mul33x33(temp_33,transpose(dFpinvdF(1:3,1:3,p,o)))
enddo; enddo
enddo elementLooping6
@ -1268,8 +1244,9 @@ subroutine crystallite_integrateStateRK4()
plasticState, &
sourceState, &
phase_Nsources, &
material_Nphase, &
phaseAt, phasememberAt
use config, only: &
material_Nphase
use constitutive, only: &
constitutive_collectDotState, &
constitutive_microstructure
@ -3175,7 +3152,6 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33)
use math, only: &
math_mul33x33, &
math_inv33, &
math_transpose33, &
math_EulerToR
use material, only: &
material_EulerAngles
@ -3190,8 +3166,8 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33)
ipc ! grain index
T = math_mul33x33(math_EulerToR(material_EulerAngles(1:3,ipc,ip,el)), &
math_transpose33(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el))))
crystallite_push33ToRef = math_mul33x33(math_transpose33(T),math_mul33x33(tensor33,T))
transpose(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el))))
crystallite_push33ToRef = math_mul33x33(transpose(T),math_mul33x33(tensor33,T))
end function crystallite_push33ToRef
@ -3237,7 +3213,6 @@ logical function crystallite_integrateStress(&
math_mul3333xx3333, &
math_mul66x6, &
math_mul99x99, &
math_transpose33, &
math_inv33, &
math_invert, &
math_det33, &
@ -3363,7 +3338,7 @@ logical function crystallite_integrateStress(&
write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fp_current at el (elFE) ip ipc ',&
el,'(',mesh_element(1,el),')',ip,ipc
if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) &
write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',math_transpose33(Fp_current(1:3,1:3))
write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',transpose(Fp_current(1:3,1:3))
endif
#endif
return
@ -3379,7 +3354,7 @@ logical function crystallite_integrateStress(&
write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fi_current at el (elFE) ip ipc ',&
el,'(',mesh_element(1,el),')',ip,ipc
if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) &
write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',math_transpose33(Fi_current(1:3,1:3))
write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',transpose(Fi_current(1:3,1:3))
endif
#endif
return
@ -3439,9 +3414,9 @@ logical function crystallite_integrateStress(&
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i3,/)') '<< CRYST >> stress iteration ', NiterationStressLp
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lpguess', math_transpose33(Lpguess)
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fi', math_transpose33(Fi_new)
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fe', math_transpose33(Fe)
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lpguess', transpose(Lpguess)
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fi', transpose(Fi_new)
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Fe', transpose(Fe)
write(6,'(a,/,6(e20.10,1x))') '<< CRYST >> Tstar', Tstar_v
endif
#endif
@ -3452,7 +3427,7 @@ logical function crystallite_integrateStress(&
if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lp_constitutive', math_transpose33(Lp_constitutive)
write(6,'(a,/,3(12x,3(e20.10,1x)/))') '<< CRYST >> Lp_constitutive', transpose(Lp_constitutive)
endif
#endif
@ -3498,7 +3473,7 @@ logical function crystallite_integrateStress(&
if (mod(jacoCounterLp, iJacoLpresiduum) == 0_pInt) then
dFe_dLp3333 = 0.0_pReal
forall(o=1_pInt:3_pInt,p=1_pInt:3_pInt) &
dFe_dLp3333(o,1:3,p,1:3) = A(o,p)*math_transpose33(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j)
dFe_dLp3333(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new) ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j)
dFe_dLp3333 = - dt * dFe_dLp3333
dRLp_dLp = math_identity2nd(9_pInt) &
- math_Plain3333to99(math_mul3333xx3333(math_mul3333xx3333(dLp_dT3333,dT_dFe3333),dFe_dLp3333))
@ -3528,10 +3503,10 @@ logical function crystallite_integrateStress(&
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLp',transpose(math_Plain3333to99(dFe_dLp3333))
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dT_dFe_constitutive',transpose(math_Plain3333to99(dT_dFe3333))
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLp_dT_constitutive',transpose(math_Plain3333to99(dLp_dT3333))
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> A',math_transpose33(A)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> B',math_transpose33(B)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive',math_transpose33(Lp_constitutive)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lpguess',math_transpose33(Lpguess)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> A',transpose(A)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> B',transpose(B)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lp_constitutive',transpose(Lp_constitutive)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Lpguess',transpose(Lpguess)
endif
endif
#endif
@ -3559,8 +3534,8 @@ logical function crystallite_integrateStress(&
if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive', math_transpose33(Li_constitutive)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess', math_transpose33(Liguess)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive', transpose(Li_constitutive)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess', transpose(Liguess)
endif
#endif
!* update current residuum and check for convergence of loop
@ -3615,8 +3590,8 @@ logical function crystallite_integrateStress(&
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dFe_dLi',transpose(math_Plain3333to99(dFe_dLi3333))
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dT_dFi_constitutive',transpose(math_Plain3333to99(dT_dFi3333))
write(6,'(a,/,9(12x,9(e15.3,1x)/))') '<< CRYST >> dLi_dT_constitutive',transpose(math_Plain3333to99(dLi_dT3333))
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive',math_transpose33(Li_constitutive)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess',math_transpose33(Liguess)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Li_constitutive',transpose(Li_constitutive)
write(6,'(a,/,3(12x,3(e20.7,1x)/))') '<< CRYST >> Liguess',transpose(Liguess)
endif
endif
#endif
@ -3648,7 +3623,7 @@ logical function crystallite_integrateStress(&
if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) &
write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',math_transpose33(invFp_new)
write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> invFp_new',transpose(invFp_new)
endif
#endif
return
@ -3659,7 +3634,7 @@ logical function crystallite_integrateStress(&
crystallite_P(1:3,1:3,ipc,ip,el) = math_mul33x33(math_mul33x33(Fg_new,invFp_new), &
math_mul33x33(math_Mandel6to33(Tstar_v), &
math_transpose33(invFp_new)))
transpose(invFp_new)))
!* store local values in global variables
@ -3679,13 +3654,13 @@ logical function crystallite_integrateStress(&
if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> P / MPa',math_transpose33(crystallite_P(1:3,1:3,ipc,ip,el))*1.0e-6_pReal
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> P / MPa',transpose(crystallite_P(1:3,1:3,ipc,ip,el))*1.0e-6_pReal
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Cauchy / MPa', &
math_mul33x33(crystallite_P(1:3,1:3,ipc,ip,el), math_transpose33(Fg_new)) * 1.0e-6_pReal / math_det33(Fg_new)
math_mul33x33(crystallite_P(1:3,1:3,ipc,ip,el), transpose(Fg_new)) * 1.0e-6_pReal / math_det33(Fg_new)
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fe Lp Fe^-1', &
math_transpose33(math_mul33x33(Fe_new, math_mul33x33(crystallite_Lp(1:3,1:3,ipc,ip,el), math_inv33(Fe_new)))) ! transpose to get correct print out order
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp',math_transpose33(crystallite_Fp(1:3,1:3,ipc,ip,el))
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fi',math_transpose33(crystallite_Fi(1:3,1:3,ipc,ip,el))
transpose(math_mul33x33(Fe_new, math_mul33x33(crystallite_Lp(1:3,1:3,ipc,ip,el), math_inv33(Fe_new)))) ! transpose to get correct print out order
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp',transpose(crystallite_Fp(1:3,1:3,ipc,ip,el))
write(6,'(a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fi',transpose(crystallite_Fi(1:3,1:3,ipc,ip,el))
endif
#endif
@ -3802,7 +3777,6 @@ function crystallite_postResults(ipc, ip, el)
math_qToEuler, &
math_qToEulerAxisAngle, &
math_mul33x33, &
math_transpose33, &
math_det33, &
math_I3, &
inDeg, &
@ -3905,41 +3879,41 @@ function crystallite_postResults(ipc, ip, el)
case (defgrad_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize])
reshape(transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)),[mySize])
case (e_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = 0.5_pReal * reshape((math_mul33x33( &
math_transpose33(crystallite_partionedF(1:3,1:3,ipc,ip,el)), &
transpose(crystallite_partionedF(1:3,1:3,ipc,ip,el)), &
crystallite_partionedF(1:3,1:3,ipc,ip,el)) - math_I3),[mySize])
case (fe_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Fe(1:3,1:3,ipc,ip,el)),[mySize])
reshape(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)),[mySize])
case (ee_ID)
Ee = 0.5_pReal *(math_mul33x33(math_transpose33(crystallite_Fe(1:3,1:3,ipc,ip,el)), &
Ee = 0.5_pReal *(math_mul33x33(transpose(crystallite_Fe(1:3,1:3,ipc,ip,el)), &
crystallite_Fe(1:3,1:3,ipc,ip,el)) - math_I3)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = reshape(Ee,[mySize])
case (fp_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Fp(1:3,1:3,ipc,ip,el)),[mySize])
reshape(transpose(crystallite_Fp(1:3,1:3,ipc,ip,el)),[mySize])
case (fi_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Fi(1:3,1:3,ipc,ip,el)),[mySize])
reshape(transpose(crystallite_Fi(1:3,1:3,ipc,ip,el)),[mySize])
case (lp_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Lp(1:3,1:3,ipc,ip,el)),[mySize])
reshape(transpose(crystallite_Lp(1:3,1:3,ipc,ip,el)),[mySize])
case (li_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_Li(1:3,1:3,ipc,ip,el)),[mySize])
reshape(transpose(crystallite_Li(1:3,1:3,ipc,ip,el)),[mySize])
case (p_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = &
reshape(math_transpose33(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize])
reshape(transpose(crystallite_P(1:3,1:3,ipc,ip,el)),[mySize])
case (s_ID)
mySize = 9_pInt
crystallite_postResults(c+1:c+mySize) = &

3
src/damage_local.f90
View File

@ -70,7 +70,8 @@ subroutine damage_local_init(fileUnit)
damageState, &
damageMapping, &
damage, &
damage_initialPhi, &
damage_initialPhi
use config, only: &
material_partHomogenization
implicit none

1
src/damage_none.f90
View File

@ -26,6 +26,7 @@ subroutine damage_none_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

3
src/damage_nonlocal.f90
View File

@ -75,7 +75,8 @@ subroutine damage_nonlocal_init(fileUnit)
damageState, &
damageMapping, &
damage, &
damage_initialPhi, &
damage_initialPhi
use config, only: &
material_partHomogenization
implicit none

20
src/homogenization.f90
View File

@ -100,6 +100,12 @@ subroutine homogenization_init
use crystallite, only: &
crystallite_maxSizePostResults
#endif
use config, only: &
config_deallocate, &
material_configFile, &
material_localFileExt, &
config_homogenization, &
homogenization_name
use material
use homogenization_none
use homogenization_isostrain
@ -196,7 +202,7 @@ subroutine homogenization_init
! write description file for homogenization output
mainProcess2: if (worldrank == 0) then
call IO_write_jobFile(FILEUNIT,'outputHomogenization')
do p = 1,material_Nhomogenization
do p = 1,size(config_homogenization)
if (any(material_homog == p)) then
i = homogenization_typeInstance(p) ! which instance of this homogenization type
valid = .true. ! assume valid
@ -369,6 +375,8 @@ subroutine homogenization_init
close(FILEUNIT)
endif mainProcess2
call config_deallocate('material.config/homogenization')
!--------------------------------------------------------------------------------------------------
! allocate and initialize global variables
allocate(materialpoint_dPdF(3,3,3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal)
@ -394,7 +402,7 @@ subroutine homogenization_init
vacancyflux_maxSizePostResults = 0_pInt
porosity_maxSizePostResults = 0_pInt
hydrogenflux_maxSizePostResults = 0_pInt
do p = 1,material_Nhomogenization
do p = 1,size(config_homogenization)
homogenization_maxSizePostResults = max(homogenization_maxSizePostResults,homogState (p)%sizePostResults)
thermal_maxSizePostResults = max(thermal_maxSizePostResults, thermalState (p)%sizePostResults)
damage_maxSizePostResults = max(damage_maxSizePostResults ,damageState (p)%sizePostResults)
@ -443,11 +451,9 @@ subroutine homogenization_init
allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems))
#endif
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(/,a)') ' <<<+- homogenization init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt) then
#ifdef TODO
@ -475,7 +481,7 @@ subroutine homogenization_init
flush(6)
if (debug_g < 1 .or. debug_g > homogenization_Ngrains(mesh_element(3,debug_e))) &
call IO_error(602_pInt,ext_msg='component (grain)', el=debug_e, g=debug_g)
call IO_error(602_pInt,ext_msg='constituent', el=debug_e, g=debug_g)
end subroutine homogenization_init

33
src/homogenization_RGC.f90
View File

@ -100,6 +100,7 @@ subroutine homogenization_RGC_init(fileUnit)
FE_geomtype
use IO
use material
use config
implicit none
integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration
@ -166,52 +167,30 @@ subroutine homogenization_RGC_init(fileUnit)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case('constitutivework')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = constitutivework_ID
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('penaltyenergy')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = penaltyenergy_ID
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('volumediscrepancy')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = volumediscrepancy_ID
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('averagerelaxrate')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = averagerelaxrate_ID
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('maximumrelaxrate')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = maximumrelaxrate_ID
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('magnitudemismatch')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = magnitudemismatch_ID
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('ipcoords')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = ipcoords_ID
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('avgdefgrad','avgf')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = avgdefgrad_ID
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case('avgp','avgfirstpiola','avg1stpiola')
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) + 1_pInt
homogenization_RGC_outputID(homogenization_RGC_Noutput(i),i) = avgfirstpiola_ID
homogenization_RGC_output(homogenization_RGC_Noutput(i),i) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
case default
homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) -1_pInt ! correct for invalid
end select
case ('clustersize')

1
src/homogenization_isostrain.f90
View File

@ -62,6 +62,7 @@ subroutine homogenization_isostrain_init(fileUnit)
debug_levelBasic
use IO
use material
use config
implicit none
integer(pInt), intent(in) :: fileUnit

1
src/homogenization_none.f90
View File

@ -29,6 +29,7 @@ subroutine homogenization_none_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

3
src/hydrogenflux_cahnhilliard.f90
View File

@ -81,7 +81,8 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit)
hydrogenfluxMapping, &
hydrogenConc, &
hydrogenConcRate, &
hydrogenflux_initialCh, &
hydrogenflux_initialCh
use config, only: &
material_partHomogenization, &
material_partPhase

1
src/hydrogenflux_isoconc.f90
View File

@ -27,6 +27,7 @@ subroutine hydrogenflux_isoconc_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

3
src/kinematics_cleavage_opening.f90
View File

@ -78,7 +78,8 @@ subroutine kinematics_cleavage_opening_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_cleavage_opening_label, &
KINEMATICS_cleavage_opening_ID, &
KINEMATICS_cleavage_opening_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use lattice, only: &

3
src/kinematics_hydrogen_strain.f90
View File

@ -68,7 +68,8 @@ subroutine kinematics_hydrogen_strain_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_hydrogen_strain_label, &
KINEMATICS_hydrogen_strain_ID, &
KINEMATICS_hydrogen_strain_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase

3
src/kinematics_slipplane_opening.f90
View File

@ -78,7 +78,8 @@ subroutine kinematics_slipplane_opening_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_slipplane_opening_label, &
KINEMATICS_slipplane_opening_ID, &
KINEMATICS_slipplane_opening_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use lattice, only: &

3
src/kinematics_thermal_expansion.f90
View File

@ -68,7 +68,8 @@ subroutine kinematics_thermal_expansion_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_thermal_expansion_label, &
KINEMATICS_thermal_expansion_ID, &
KINEMATICS_thermal_expansion_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase

3
src/kinematics_vacancy_strain.f90
View File

@ -68,7 +68,8 @@ subroutine kinematics_vacancy_strain_init(fileUnit)
phase_Nkinematics, &
phase_Noutput, &
KINEMATICS_vacancy_strain_label, &
KINEMATICS_vacancy_strain_ID, &
KINEMATICS_vacancy_strain_ID
use config, only: &
material_Nphase, &
MATERIAL_partPhase

2
src/lattice.f90
View File

@ -1263,7 +1263,7 @@ subroutine lattice_init
IO_stringPos, &
IO_stringValue, &
IO_floatValue
use material, only: &
use config, only: &
material_configfile, &
material_localFileExt, &
material_partPhase

1159
src/material.f90
View File

File diff suppressed because it is too large Load Diff

792
src/math.f90
View File

@ -162,10 +162,8 @@ module math
math_rotate_forward3333, &
math_limit
private :: &
halton, &
halton_memory, &
halton_ndim_set, &
halton_seed_set
math_check, &
halton
contains
@ -217,10 +215,6 @@ subroutine math_init
write(6,'(a,4(/,26x,f17.14),/)') ' start of random sequence: ', randTest
call random_seed(put = randInit)
call halton_seed_set(int(randInit(1), pInt))
call halton_ndim_set(3_pInt)
call math_check()
end subroutine math_init
@ -229,7 +223,6 @@ end subroutine math_init
!> @brief check correctness of (some) math functions
!--------------------------------------------------------------------------------------------------
subroutine math_check
use prec, only: tol_math_check
use IO, only: IO_error
@ -284,7 +277,7 @@ subroutine math_check
endif
! +++ check rotation sense of q and R +++
call halton(3_pInt,v) ! random vector
v = halton([2_pInt,8_pInt,5_pInt]) ! random vector
R = math_qToR(q)
if (any(abs(math_mul33x3(R,v) - math_qRot(q,v)) > tol_math_check)) then
write (error_msg, '(a)' ) 'R(q)*v has different sense than q*v'
@ -1238,7 +1231,7 @@ function math_qRand()
real(pReal), dimension(4) :: math_qRand
real(pReal), dimension(3) :: rnd
call halton(3_pInt,rnd)
rnd = halton([8_pInt,4_pInt,9_pInt])
math_qRand = [cos(2.0_pReal*PI*rnd(1))*sqrt(rnd(3)), &
sin(2.0_pReal*PI*rnd(2))*sqrt(1.0_pReal-rnd(3)), &
cos(2.0_pReal*PI*rnd(2))*sqrt(1.0_pReal-rnd(3)), &
@ -1526,7 +1519,7 @@ pure function math_axisAngleToR(axis,omega)
norm = norm2(axis)
wellDefined: if (norm > 1.0e-8_pReal) then
n = axis/norm ! normalize axis to be sure
n = axis/norm ! normalize axis to be sure
s = sin(omega)
c = cos(omega)
@ -1761,7 +1754,7 @@ function math_sampleRandomOri()
implicit none
real(pReal), dimension(3) :: math_sampleRandomOri, rnd
call halton(3_pInt,rnd)
rnd = halton([1_pInt,7_pInt,3_pInt])
math_sampleRandomOri = [rnd(1)*2.0_pReal*PI, &
acos(2.0_pReal*rnd(2)-1.0_pReal), &
rnd(3)*2.0_pReal*PI]
@ -1770,118 +1763,98 @@ end function math_sampleRandomOri
!--------------------------------------------------------------------------------------------------
!> @brief draw a random sample from Gauss component with noise (in radians) half-width
!> @brief draw a sample from an Gaussian distribution around given orientation and Full Width
! at Half Maximum (FWHM)
!> @details: A uniform misorientation (limited to 2*FWHM) is sampled followed by convolution with
! a Gausian distribution
!--------------------------------------------------------------------------------------------------
function math_sampleGaussOri(center,noise)
use prec, only: &
tol_math_check
function math_sampleGaussOri(center,FWHM)
implicit none
real(pReal), intent(in) :: noise
real(pReal), intent(in) :: FWHM
real(pReal), dimension(3), intent(in) :: center
real(pReal) :: cosScatter,scatter
real(pReal), dimension(3) :: math_sampleGaussOri, disturb
real(pReal), dimension(3), parameter :: ORIGIN = 0.0_pReal
real(pReal), dimension(5) :: rnd
real(pReal) :: angle
real(pReal), dimension(3) :: math_sampleGaussOri, axis
real(pReal), dimension(4) :: rnd
real(pReal), dimension(3,3) :: R
noScatter: if (abs(noise) < tol_math_check) then
if (FWHM < 0.1_pReal*INRAD) then
math_sampleGaussOri = center
else noScatter
! Helming uses different distribution with Bessel functions
! therefore the gauss scatter width has to be scaled differently
scatter = 0.95_pReal * noise
cosScatter = cos(scatter)
else
GaussConvolution: do
rnd = halton([8_pInt,3_pInt,6_pInt,11_pInt])
axis(1) = rnd(1)*2.0_pReal-1.0_pReal ! uniform on [-1,1]
axis(2:3) = [sqrt(1.0-axis(1)**2.0_pReal)*cos(rnd(2)*2.0*PI),&
sqrt(1.0-axis(1)**2.0_pReal)*sin(rnd(2)*2.0*PI)] ! random axis
angle = (rnd(3)-0.5_pReal)*4.0_pReal*FWHM ! rotation by [0, +-2 FWHM]
R = math_axisAngleToR(axis,angle)
angle = math_EulerMisorientation([0.0_pReal,0.0_pReal,0.0_pReal],math_RtoEuler(R))
if (rnd(4) <= exp(-4.0_pReal*log(2.0_pReal)*(angle/FWHM)**2_pReal)) exit ! rejection sampling (Gaussian)
enddo GaussConvolution
math_sampleGaussOri = math_RtoEuler(math_mul33x33(R,math_EulerToR(center)))
endif
do
call halton(5_pInt,rnd)
rnd(1:3) = 2.0_pReal*rnd(1:3)-1.0_pReal ! expand 1:3 to range [-1,+1]
disturb = [ scatter * rnd(1), & ! phi1
sign(1.0_pReal,rnd(2))*acos(cosScatter+(1.0_pReal-cosScatter)*rnd(4)), & ! Phi
scatter * rnd(3)] ! phi2
if (rnd(5) <= exp(-1.0_pReal*(math_EulerMisorientation(ORIGIN,disturb)/scatter)**2_pReal)) exit
enddo
math_sampleGaussOri = math_RtoEuler(math_mul33x33(math_EulerToR(disturb),math_EulerToR(center)))
endif noScatter
end function math_sampleGaussOri
!--------------------------------------------------------------------------------------------------
!> @brief draw a random sample from Fiber component with noise (in radians)
!--------------------------------------------------------------------------------------------------
function math_sampleFiberOri(alpha,beta,noise)
use prec, only: &
tol_math_check
!> @brief draw a sample from an Gaussian distribution around given fiber texture and Full Width
! at Half Maximum (FWHM)
!-------------------------------------------------------------------------------------------------
function math_sampleFiberOri(alpha,beta,FWHM)
implicit none
real(pReal), dimension(3) :: math_sampleFiberOri, fiberInC,fiberInS,axis
real(pReal), dimension(2), intent(in) :: alpha,beta
real(pReal), dimension(6) :: rnd
real(pReal), dimension(3,3) :: oRot,fRot,pRot
real(pReal) :: noise, scatter, cos2Scatter, angle
integer(pInt), dimension(2,3), parameter :: ROTMAP = reshape([2_pInt,3_pInt,&
3_pInt,1_pInt,&
1_pInt,2_pInt],[2,3])
integer(pInt) :: i
real(pReal), intent(in) :: FWHM
real(pReal), dimension(3) :: math_sampleFiberOri, &
fInC,& !< fiber axis in crystal coordinate system
fInS,& !< fiber axis in sample coordinate system
u
real(pReal), dimension(3) :: rnd
real(pReal), dimension(:),allocatable :: a !< 2D vector to tilt
integer(pInt), dimension(:),allocatable :: idx !< components of 2D vector
real(pReal), dimension(3,3) :: R !< Rotation matrix (composed of three components)
real(pReal):: angle,c
integer(pInt):: j,& !< index of smallest component
i
! Helming uses different distribution with Bessel functions
! therefore the gauss scatter width has to be scaled differently
scatter = 0.95_pReal * noise
cos2Scatter = cos(2.0_pReal*scatter)
allocate(a(0))
allocate(idx(0))
fInC = [sin(alpha(1))*cos(alpha(2)), sin(alpha(1))*sin(alpha(2)), cos(alpha(1))]
fInS = [sin(beta(1))*cos(beta(2)), sin(beta(1))*sin(beta(2)), cos(beta(1))]
! fiber axis in crystal coordinate system
fiberInC = [ sin(alpha(1))*cos(alpha(2)) , &
sin(alpha(1))*sin(alpha(2)), &
cos(alpha(1))]
! fiber axis in sample coordinate system
fiberInS = [ sin(beta(1))*cos(beta(2)), &
sin(beta(1))*sin(beta(2)), &
cos(beta(1))]
R = math_EulerAxisAngleToR(math_crossproduct(fInC,fInS),-acos(dot_product(fInC,fInS))) !< rotation to align fiber axis in crystal and sample system
! ---# rotation matrix from sample to crystal system #---
angle = -acos(dot_product(fiberInC,fiberInS))
if(abs(angle) > tol_math_check) then
! rotation axis between sample and crystal system (cross product)
forall(i=1_pInt:3_pInt) axis(i) = fiberInC(ROTMAP(1,i))*fiberInS(ROTMAP(2,i))-fiberInC(ROTMAP(2,i))*fiberInS(ROTMAP(1,i))
oRot = math_EulerAxisAngleToR(math_crossproduct(fiberInC,fiberInS),angle)
else
oRot = math_I3
end if
rnd = halton([7_pInt,10_pInt,3_pInt])
R = math_mul33x33(R,math_EulerAxisAngleToR(fInS,rnd(1)*2.0_pReal*PI)) !< additional rotation (0..360deg) perpendicular to fiber axis
! ---# rotation matrix about fiber axis (random angle) #---
do
call halton(6_pInt,rnd)
fRot = math_EulerAxisAngleToR(fiberInS,rnd(1)*2.0_pReal*pi)
if (FWHM > 0.1_pReal*INRAD) then
reducedTo2D: do i=1_pInt,3_pInt
if (i /= minloc(abs(fInS),1)) then
a=[a,fInS(i)]
idx=[idx,i]
else
j = i
endif
enddo reducedTo2D
GaussConvolution: do
angle = (rnd(2)-0.5_pReal)*4.0_pReal*FWHM ! rotation by [0, +-2 FWHM]
! solve cos(angle) = dot_product(fInS,u) under the assumption that their smallest component is the same
c = cos(angle)-fInS(j)**2
u(idx(2)) = -(2.0_pReal*c*a(2) + sqrt(4*((c*a(2))**2-sum(a**2)*(c**2-a(1)**2*(1-fInS(j)**2)))))/&
(2*sum(a**2))
u(idx(1)) = sqrt(1-u(idx(2))**2-fInS(j)**2)
u(j) = fInS(j)
! ---# rotation about random axis perpend to fiber #---
! random axis pependicular to fiber axis
axis(1:2) = rnd(2:3)
if (abs(fiberInS(3)) > tol_math_check) then
axis(3)=-(axis(1)*fiberInS(1)+axis(2)*fiberInS(2))/fiberInS(3)
else if(abs(fiberInS(2)) > tol_math_check) then
axis(3)=axis(2)
axis(2)=-(axis(1)*fiberInS(1)+axis(3)*fiberInS(3))/fiberInS(2)
else if(abs(fiberInS(1)) > tol_math_check) then
axis(3)=axis(1)
axis(1)=-(axis(2)*fiberInS(2)+axis(3)*fiberInS(3))/fiberInS(1)
end if
! scattered rotation angle
if (noise > 0.0_pReal) then
angle = acos(cos2Scatter+(1.0_pReal-cos2Scatter)*rnd(4))
if (rnd(5) <= exp(-1.0_pReal*(angle/scatter)**2.0_pReal)) exit
else
angle = 0.0_pReal
exit
end if
enddo
if (rnd(6) <= 0.5) angle = -angle
pRot = math_EulerAxisAngleToR(axis,angle)
! ---# apply the three rotations #---
math_sampleFiberOri = math_RtoEuler(math_mul33x33(pRot,math_mul33x33(fRot,oRot)))
rejectionSampling: if (rnd(3) <= exp(-4.0_pReal*log(2.0_pReal)*(angle/FWHM)**2_pReal)) then
R = math_mul33x33(R,math_EulerAxisAngleToR(math_crossproduct(u,fInS),angle)) ! tilt around direction of smallest component
exit
endif rejectionSampling
rnd = halton([7_pInt,10_pInt,3_pInt])
enddo GaussConvolution
endif
math_sampleFiberOri = math_RtoEuler(R)
end function math_sampleFiberOri
@ -1903,19 +1876,18 @@ real(pReal) function math_sampleGaussVar(meanvalue, stddev, width)
if (abs(stddev) < tol_math_check) then
math_sampleGaussVar = meanvalue
return
else
myWidth = merge(width,3.0_pReal,present(width)) ! use +-3*sigma as default value for scatter if not given
do
rnd = halton([6_pInt,2_pInt])
scatter = myWidth * (2.0_pReal * rnd(1) - 1.0_pReal)
if (rnd(2) <= exp(-0.5_pReal * scatter ** 2.0_pReal)) exit ! test if scattered value is drawn
enddo
math_sampleGaussVar = scatter * stddev
endif
myWidth = merge(width,3.0_pReal,present(width)) ! use +-3*sigma as default value for scatter if not given
do
call halton(2_pInt, rnd)
scatter = myWidth * (2.0_pReal * rnd(1) - 1.0_pReal)
if (rnd(2) <= exp(-0.5_pReal * scatter ** 2.0_pReal)) exit ! test if scattered value is drawn
enddo
math_sampleGaussVar = scatter * stddev
end function math_sampleGaussVar
@ -2285,388 +2257,228 @@ pure function math_invariantsSym33(m)
end function math_invariantsSym33
!--------------------------------------------------------------------------------------------------
!> @brief computes the next element in the Halton sequence.
!-------------------------------------------------------------------------------------------------
!> @brief computes an element of a Halton sequence.
!> @author John Burkardt
!--------------------------------------------------------------------------------------------------
subroutine halton(ndim, r)
!> @author Martin Diehl
!> @details Incrementally increasing elements of the Halton sequence for given bases (> 0)
!> @details Reference:
!> @details J.H. Halton: On the efficiency of certain quasi-random sequences of points in evaluating
!> @details multi-dimensional integrals, Numerische Mathematik, Volume 2, pages 84-90, 1960.
!> @details Reference for prime numbers:
!> @details Milton Abramowitz and Irene Stegun: Handbook of Mathematical Functions,
!> @details US Department of Commerce, 1964, pages 870-873.
!> @details Daniel Zwillinger: CRC Standard Mathematical Tables and Formulae,
!> @details 30th Edition, CRC Press, 1996, pages 95-98.
!-------------------------------------------------------------------------------------------------
function halton(bases)
implicit none
integer(pInt), intent(in) :: ndim !< dimension of the element
real(pReal), intent(out), dimension(ndim) :: r !< next element of the current Halton sequence
integer(pInt), dimension(ndim) :: base
integer(pInt) :: seed
integer(pInt), dimension(1) :: value_halton
integer(pInt), intent(in), dimension(:):: &
bases !< bases (prime number ID)
real(pReal), dimension(size(bases)) :: &
halton
integer(pInt), save :: &
current = 1_pInt
real(pReal), dimension(size(bases)) :: &
base_inv
integer(pInt), dimension(size(bases)) :: &
base, &
t
integer(pInt), dimension(0:1600), parameter :: &
prime = int([&
1, &
2, 3, 5, 7, 11, 13, 17, 19, 23, 29, &
31, 37, 41, 43, 47, 53, 59, 61, 67, 71, &
73, 79, 83, 89, 97, 101, 103, 107, 109, 113, &
127, 131, 137, 139, 149, 151, 157, 163, 167, 173, &
179, 181, 191, 193, 197, 199, 211, 223, 227, 229, &
233, 239, 241, 251, 257, 263, 269, 271, 277, 281, &
283, 293, 307, 311, 313, 317, 331, 337, 347, 349, &
353, 359, 367, 373, 379, 383, 389, 397, 401, 409, &
419, 421, 431, 433, 439, 443, 449, 457, 461, 463, &
467, 479, 487, 491, 499, 503, 509, 521, 523, 541, &
! 101:200
547, 557, 563, 569, 571, 577, 587, 593, 599, 601, &
607, 613, 617, 619, 631, 641, 643, 647, 653, 659, &
661, 673, 677, 683, 691, 701, 709, 719, 727, 733, &
739, 743, 751, 757, 761, 769, 773, 787, 797, 809, &
811, 821, 823, 827, 829, 839, 853, 857, 859, 863, &
877, 881, 883, 887, 907, 911, 919, 929, 937, 941, &
947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, &
1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, &
1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151, &
1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223, &
! 201:300
1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291, &
1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, &
1381, 1399, 1409, 1423, 1427, 1429, 1433, 1439, 1447, 1451, &
1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511, &
1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583, &
1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, &
1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, &
1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811, &
1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889, &
1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987, &
! 301:400
1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, &
2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129, &
2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, &
2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287, &
2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, &
2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423, &
2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531, &
2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617, &
2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, &
2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741, &
! 401:500
2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819, &
2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903, &
2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, &
3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, &
3083, 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181, &
3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253, 3257, &
3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331, &
3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413, &
3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511, &
3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571, &
! 501:600
3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643, &
3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727, &
3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, &
3823, 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907, &
3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967, 3989, &
4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, &
4073, 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139, &
4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231, &
4241, 4243, 4253, 4259, 4261, 4271, 4273, 4283, 4289, 4297, &
4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409, &
! 601:700
4421, 4423, 4441, 4447, 4451, 4457, 4463, 4481, 4483, 4493, &
4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583, &
4591, 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657, &
4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751, &
4759, 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831, &
4861, 4871, 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937, &
4943, 4951, 4957, 4967, 4969, 4973, 4987, 4993, 4999, 5003, &
5009, 5011, 5021, 5023, 5039, 5051, 5059, 5077, 5081, 5087, &
5099, 5101, 5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179, &
5189, 5197, 5209, 5227, 5231, 5233, 5237, 5261, 5273, 5279, &
! 701:800
5281, 5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387, &
5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443, &
5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519, 5521, &
5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623, 5639, &
5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693, &
5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791, &
5801, 5807, 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857, &
5861, 5867, 5869, 5879, 5881, 5897, 5903, 5923, 5927, 5939, &
5953, 5981, 5987, 6007, 6011, 6029, 6037, 6043, 6047, 6053, &
6067, 6073, 6079, 6089, 6091, 6101, 6113, 6121, 6131, 6133, &
! 801:900
6143, 6151, 6163, 6173, 6197, 6199, 6203, 6211, 6217, 6221, &
6229, 6247, 6257, 6263, 6269, 6271, 6277, 6287, 6299, 6301, &
6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359, 6361, 6367, &
6373, 6379, 6389, 6397, 6421, 6427, 6449, 6451, 6469, 6473, &
6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571, &
6577, 6581, 6599, 6607, 6619, 6637, 6653, 6659, 6661, 6673, &
6679, 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761, &
6763, 6779, 6781, 6791, 6793, 6803, 6823, 6827, 6829, 6833, &
6841, 6857, 6863, 6869, 6871, 6883, 6899, 6907, 6911, 6917, &
6947, 6949, 6959, 6961, 6967, 6971, 6977, 6983, 6991, 6997, &
! 901:1000
7001, 7013, 7019, 7027, 7039, 7043, 7057, 7069, 7079, 7103, &
7109, 7121, 7127, 7129, 7151, 7159, 7177, 7187, 7193, 7207, &
7211, 7213, 7219, 7229, 7237, 7243, 7247, 7253, 7283, 7297, &
7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369, 7393, 7411, &
7417, 7433, 7451, 7457, 7459, 7477, 7481, 7487, 7489, 7499, &
7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561, &
7573, 7577, 7583, 7589, 7591, 7603, 7607, 7621, 7639, 7643, &
7649, 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723, &
7727, 7741, 7753, 7757, 7759, 7789, 7793, 7817, 7823, 7829, &
7841, 7853, 7867, 7873, 7877, 7879, 7883, 7901, 7907, 7919, &
! 1001:1100
7927, 7933, 7937, 7949, 7951, 7963, 7993, 8009, 8011, 8017, &
8039, 8053, 8059, 8069, 8081, 8087, 8089, 8093, 8101, 8111, &
8117, 8123, 8147, 8161, 8167, 8171, 8179, 8191, 8209, 8219, &
8221, 8231, 8233, 8237, 8243, 8263, 8269, 8273, 8287, 8291, &
8293, 8297, 8311, 8317, 8329, 8353, 8363, 8369, 8377, 8387, &
8389, 8419, 8423, 8429, 8431, 8443, 8447, 8461, 8467, 8501, &
8513, 8521, 8527, 8537, 8539, 8543, 8563, 8573, 8581, 8597, &
8599, 8609, 8623, 8627, 8629, 8641, 8647, 8663, 8669, 8677, &
8681, 8689, 8693, 8699, 8707, 8713, 8719, 8731, 8737, 8741, &
8747, 8753, 8761, 8779, 8783, 8803, 8807, 8819, 8821, 8831, &
! 1101:1200
8837, 8839, 8849, 8861, 8863, 8867, 8887, 8893, 8923, 8929, &
8933, 8941, 8951, 8963, 8969, 8971, 8999, 9001, 9007, 9011, &
9013, 9029, 9041, 9043, 9049, 9059, 9067, 9091, 9103, 9109, &
9127, 9133, 9137, 9151, 9157, 9161, 9173, 9181, 9187, 9199, &
9203, 9209, 9221, 9227, 9239, 9241, 9257, 9277, 9281, 9283, &
9293, 9311, 9319, 9323, 9337, 9341, 9343, 9349, 9371, 9377, &
9391, 9397, 9403, 9413, 9419, 9421, 9431, 9433, 9437, 9439, &
9461, 9463, 9467, 9473, 9479, 9491, 9497, 9511, 9521, 9533, &
9539, 9547, 9551, 9587, 9601, 9613, 9619, 9623, 9629, 9631, &
9643, 9649, 9661, 9677, 9679, 9689, 9697, 9719, 9721, 9733, &
! 1201:1300
9739, 9743, 9749, 9767, 9769, 9781, 9787, 9791, 9803, 9811, &
9817, 9829, 9833, 9839, 9851, 9857, 9859, 9871, 9883, 9887, &
9901, 9907, 9923, 9929, 9931, 9941, 9949, 9967, 9973, 10007, &
10009, 10037, 10039, 10061, 10067, 10069, 10079, 10091, 10093, 10099, &
10103, 10111, 10133, 10139, 10141, 10151, 10159, 10163, 10169, 10177, &
10181, 10193, 10211, 10223, 10243, 10247, 10253, 10259, 10267, 10271, &
10273, 10289, 10301, 10303, 10313, 10321, 10331, 10333, 10337, 10343, &
10357, 10369, 10391, 10399, 10427, 10429, 10433, 10453, 10457, 10459, &
10463, 10477, 10487, 10499, 10501, 10513, 10529, 10531, 10559, 10567, &
10589, 10597, 10601, 10607, 10613, 10627, 10631, 10639, 10651, 10657, &
! 1301:1400
10663, 10667, 10687, 10691, 10709, 10711, 10723, 10729, 10733, 10739, &
10753, 10771, 10781, 10789, 10799, 10831, 10837, 10847, 10853, 10859, &
10861, 10867, 10883, 10889, 10891, 10903, 10909, 10937, 10939, 10949, &
10957, 10973, 10979, 10987, 10993, 11003, 11027, 11047, 11057, 11059, &
11069, 11071, 11083, 11087, 11093, 11113, 11117, 11119, 11131, 11149, &
11159, 11161, 11171, 11173, 11177, 11197, 11213, 11239, 11243, 11251, &
11257, 11261, 11273, 11279, 11287, 11299, 11311, 11317, 11321, 11329, &
11351, 11353, 11369, 11383, 11393, 11399, 11411, 11423, 11437, 11443, &
11447, 11467, 11471, 11483, 11489, 11491, 11497, 11503, 11519, 11527, &
11549, 11551, 11579, 11587, 11593, 11597, 11617, 11621, 11633, 11657, &
! 1401:1500
11677, 11681, 11689, 11699, 11701, 11717, 11719, 11731, 11743, 11777, &
11779, 11783, 11789, 11801, 11807, 11813, 11821, 11827, 11831, 11833, &
11839, 11863, 11867, 11887, 11897, 11903, 11909, 11923, 11927, 11933, &
11939, 11941, 11953, 11959, 11969, 11971, 11981, 11987, 12007, 12011, &
12037, 12041, 12043, 12049, 12071, 12073, 12097, 12101, 12107, 12109, &
12113, 12119, 12143, 12149, 12157, 12161, 12163, 12197, 12203, 12211, &
12227, 12239, 12241, 12251, 12253, 12263, 12269, 12277, 12281, 12289, &
12301, 12323, 12329, 12343, 12347, 12373, 12377, 12379, 12391, 12401, &
12409, 12413, 12421, 12433, 12437, 12451, 12457, 12473, 12479, 12487, &
12491, 12497, 12503, 12511, 12517, 12527, 12539, 12541, 12547, 12553, &
! 1501:1600
12569, 12577, 12583, 12589, 12601, 12611, 12613, 12619, 12637, 12641, &
12647, 12653, 12659, 12671, 12689, 12697, 12703, 12713, 12721, 12739, &
12743, 12757, 12763, 12781, 12791, 12799, 12809, 12821, 12823, 12829, &
12841, 12853, 12889, 12893, 12899, 12907, 12911, 12917, 12919, 12923, &
12941, 12953, 12959, 12967, 12973, 12979, 12983, 13001, 13003, 13007, &
13009, 13033, 13037, 13043, 13049, 13063, 13093, 13099, 13103, 13109, &
13121, 13127, 13147, 13151, 13159, 13163, 13171, 13177, 13183, 13187, &
13217, 13219, 13229, 13241, 13249, 13259, 13267, 13291, 13297, 13309, &
13313, 13327, 13331, 13337, 13339, 13367, 13381, 13397, 13399, 13411, &
13417, 13421, 13441, 13451, 13457, 13463, 13469, 13477, 13487, 13499],pInt)
call halton_memory ('GET', 'SEED', 1_pInt, value_halton)
seed = value_halton(1)
current = current + 1_pInt
call halton_memory ('GET', 'BASE', ndim, base)
base = prime(bases)
base_inv = 1.0_pReal/real(base,pReal)
call i_to_halton (seed, base, ndim, r)
halton = 0.0_pReal
t = current
value_halton(1) = 1_pInt
call halton_memory ('INC', 'SEED', 1_pInt, value_halton)
do while (any( t /= 0_pInt) )
halton = halton + real(mod(t,base), pReal) * base_inv
base_inv = base_inv / real(base, pReal)
t = t / base
enddo
!--------------------------------------------------------------------------------------------------
contains
!-------------------------------------------------------------------------------------------------
!> @brief computes an element of a Halton sequence.
!> @details Only the absolute value of SEED is considered. SEED = 0 is allowed, and returns R = 0.
!> @details Halton Bases should be distinct prime numbers. This routine only checks that each base
!> @details is greater than 1.
!> @details Reference:
!> @details J.H. Halton: On the efficiency of certain quasi-random sequences of points in evaluating
!> @details multi-dimensional integrals, Numerische Mathematik, Volume 2, pages 84-90, 1960.
!> @author John Burkardt
!-------------------------------------------------------------------------------------------------
subroutine i_to_halton (seed, base, ndim, r)
use IO, only: &
IO_error
implicit none
integer(pInt), intent(in) :: &
ndim, & !< dimension of the sequence
seed !< index of the desired element
integer(pInt), intent(in), dimension(ndim) :: base !< Halton bases
real(pReal), intent(out), dimension(ndim) :: r !< the SEED-th element of the Halton sequence for the given bases
real(pReal), dimension(ndim) :: base_inv
integer(pInt), dimension(ndim) :: &
digit, &
seed2
seed2 = abs(seed)
r = 0.0_pReal
if (any (base(1:ndim) <= 1_pInt)) call IO_error(error_ID=405_pInt)
base_inv(1:ndim) = 1.0_pReal / real (base(1:ndim), pReal)
do while ( any ( seed2(1:ndim) /= 0_pInt) )
digit(1:ndim) = mod ( seed2(1:ndim), base(1:ndim))
r(1:ndim) = r(1:ndim) + real ( digit(1:ndim), pReal) * base_inv(1:ndim)
base_inv(1:ndim) = base_inv(1:ndim) / real ( base(1:ndim), pReal)
seed2(1:ndim) = seed2(1:ndim) / base(1:ndim)
enddo
end subroutine i_to_halton
end subroutine halton
!--------------------------------------------------------------------------------------------------
!> @brief sets or returns quantities associated with the Halton sequence.
!> @details If action_halton is 'SET' and action_halton is 'BASE', then NDIM is input, and
!> @details is the number of entries in value_halton to be put into BASE.
!> @details If action_halton is 'SET', then on input, value_halton contains values to be assigned
!> @details to the internal variable.
!> @details If action_halton is 'GET', then on output, value_halton contains the values of
!> @details the specified internal variable.
!> @details If action_halton is 'INC', then on input, value_halton contains the increment to
!> @details be added to the specified internal variable.
!> @author John Burkardt
!--------------------------------------------------------------------------------------------------
subroutine halton_memory (action_halton, name_halton, ndim, value_halton)
use IO, only: &
IO_lc
implicit none
character(len = *), intent(in) :: &
action_halton, & !< desired action: GET the value of a particular quantity, SET the value of a particular quantity, INC the value of a particular quantity (only for SEED)
name_halton !< name of the quantity: BASE: Halton base(s), NDIM: spatial dimension, SEED: current Halton seed
integer(pInt), dimension(*), intent(inout) :: value_halton
integer(pInt), allocatable, save, dimension(:) :: base
logical, save :: first_call = .true.
integer(pInt), intent(in) :: ndim !< dimension of the quantity
integer(pInt), save :: ndim_save = 0_pInt, seed = 1_pInt
integer(pInt) :: i
if (first_call) then
ndim_save = 1_pInt
allocate(base(ndim_save))
base(1) = 2_pInt
first_call = .false.
endif
!--------------------------------------------------------------------------------------------------
! Set
actionHalton: if(IO_lc(action_halton(1:1)) == 's') then
nameSet: if(IO_lc(name_halton(1:1)) == 'b') then
if(ndim_save /= ndim) ndim_save = ndim
base = value_halton(1:ndim)
elseif(IO_lc(name_halton(1:1)) == 'n') then nameSet
if(ndim_save /= value_halton(1)) then
ndim_save = value_halton(1)
base = [(prime(i),i=1_pInt,ndim_save)]
else
ndim_save = value_halton(1)
endif
elseif(IO_lc(name_halton(1:1)) == 's') then nameSet
seed = value_halton(1)
endif nameSet
!--------------------------------------------------------------------------------------------------
! Get
elseif(IO_lc(action_halton(1:1)) == 'g') then actionHalton
nameGet: if(IO_lc(name_halton(1:1)) == 'b') then
if(ndim /= ndim_save) then
ndim_save = ndim
base = [(prime(i),i=1_pInt,ndim_save)]
endif
value_halton(1:ndim_save) = base(1:ndim_save)
elseif(IO_lc(name_halton(1:1)) == 'n') then nameGet
value_halton(1) = ndim_save
elseif(IO_lc(name_halton(1:1)) == 's') then nameGet
value_halton(1) = seed
endif nameGet
!--------------------------------------------------------------------------------------------------
! Increment
elseif(IO_lc(action_halton(1:1)) == 'i') then actionHalton
if(IO_lc(name_halton(1:1)) == 's') seed = seed + value_halton(1)
endif actionHalton
!--------------------------------------------------------------------------------------------------
contains
!--------------------------------------------------------------------------------------------------
!> @brief returns any of the first 1500 prime numbers.
!> @details n = 0 is legal, returning PRIME = 1.
!> @details Reference:
!> @details Milton Abramowitz and Irene Stegun: Handbook of Mathematical Functions,
!> @details US Department of Commerce, 1964, pages 870-873.
!> @details Daniel Zwillinger: CRC Standard Mathematical Tables and Formulae,
!> @details 30th Edition, CRC Press, 1996, pages 95-98.
!> @author John Burkardt
!--------------------------------------------------------------------------------------------------
integer(pInt) function prime(n)
use IO, only: &
IO_error
implicit none
integer(pInt), intent(in) :: n !< index of the desired prime number
integer(pInt), dimension(0:1500), parameter :: &
npvec = int([&
1, &
2, 3, 5, 7, 11, 13, 17, 19, 23, 29, &
31, 37, 41, 43, 47, 53, 59, 61, 67, 71, &
73, 79, 83, 89, 97, 101, 103, 107, 109, 113, &
127, 131, 137, 139, 149, 151, 157, 163, 167, 173, &
179, 181, 191, 193, 197, 199, 211, 223, 227, 229, &
233, 239, 241, 251, 257, 263, 269, 271, 277, 281, &
283, 293, 307, 311, 313, 317, 331, 337, 347, 349, &
353, 359, 367, 373, 379, 383, 389, 397, 401, 409, &
419, 421, 431, 433, 439, 443, 449, 457, 461, 463, &
467, 479, 487, 491, 499, 503, 509, 521, 523, 541, &
! 101:200
547, 557, 563, 569, 571, 577, 587, 593, 599, 601, &
607, 613, 617, 619, 631, 641, 643, 647, 653, 659, &
661, 673, 677, 683, 691, 701, 709, 719, 727, 733, &
739, 743, 751, 757, 761, 769, 773, 787, 797, 809, &
811, 821, 823, 827, 829, 839, 853, 857, 859, 863, &
877, 881, 883, 887, 907, 911, 919, 929, 937, 941, &
947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, &
1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, &
1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151, &
1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223, &
! 201:300
1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291, &
1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, &
1381, 1399, 1409, 1423, 1427, 1429, 1433, 1439, 1447, 1451, &
1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511, &
1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583, &
1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, &
1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, &
1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811, &
1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889, &
1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987, &
! 301:400
1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, &
2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129, &
2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, &
2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287, &
2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, &
2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423, &
2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531, &
2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617, &
2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, &
2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741, &
! 401:500
2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819, &
2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903, &
2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, &
3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079, &
3083, 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181, &
3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253, 3257, &
3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331, &
3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413, &
3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511, &
3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571, &
! 501:600
3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643, &
3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727, &
3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821, &
3823, 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907, &
3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967, 3989, &
4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, &
4073, 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139, &
4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231, &
4241, 4243, 4253, 4259, 4261, 4271, 4273, 4283, 4289, 4297, &
4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409, &
! 601:700
4421, 4423, 4441, 4447, 4451, 4457, 4463, 4481, 4483, 4493, &
4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583, &
4591, 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657, &
4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751, &
4759, 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831, &
4861, 4871, 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937, &
4943, 4951, 4957, 4967, 4969, 4973, 4987, 4993, 4999, 5003, &
5009, 5011, 5021, 5023, 5039, 5051, 5059, 5077, 5081, 5087, &
5099, 5101, 5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179, &
5189, 5197, 5209, 5227, 5231, 5233, 5237, 5261, 5273, 5279, &
! 701:800
5281, 5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387, &
5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443, &
5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519, 5521, &
5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623, 5639, &
5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693, &
5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791, &
5801, 5807, 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857, &
5861, 5867, 5869, 5879, 5881, 5897, 5903, 5923, 5927, 5939, &
5953, 5981, 5987, 6007, 6011, 6029, 6037, 6043, 6047, 6053, &
6067, 6073, 6079, 6089, 6091, 6101, 6113, 6121, 6131, 6133, &
! 801:900
6143, 6151, 6163, 6173, 6197, 6199, 6203, 6211, 6217, 6221, &
6229, 6247, 6257, 6263, 6269, 6271, 6277, 6287, 6299, 6301, &
6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359, 6361, 6367, &
6373, 6379, 6389, 6397, 6421, 6427, 6449, 6451, 6469, 6473, &
6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571, &
6577, 6581, 6599, 6607, 6619, 6637, 6653, 6659, 6661, 6673, &
6679, 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761, &
6763, 6779, 6781, 6791, 6793, 6803, 6823, 6827, 6829, 6833, &
6841, 6857, 6863, 6869, 6871, 6883, 6899, 6907, 6911, 6917, &
6947, 6949, 6959, 6961, 6967, 6971, 6977, 6983, 6991, 6997, &
! 901:1000
7001, 7013, 7019, 7027, 7039, 7043, 7057, 7069, 7079, 7103, &
7109, 7121, 7127, 7129, 7151, 7159, 7177, 7187, 7193, 7207, &
7211, 7213, 7219, 7229, 7237, 7243, 7247, 7253, 7283, 7297, &
7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369, 7393, 7411, &
7417, 7433, 7451, 7457, 7459, 7477, 7481, 7487, 7489, 7499, &
7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561, &
7573, 7577, 7583, 7589, 7591, 7603, 7607, 7621, 7639, 7643, &
7649, 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723, &
7727, 7741, 7753, 7757, 7759, 7789, 7793, 7817, 7823, 7829, &
7841, 7853, 7867, 7873, 7877, 7879, 7883, 7901, 7907, 7919, &
! 1001:1100
7927, 7933, 7937, 7949, 7951, 7963, 7993, 8009, 8011, 8017, &
8039, 8053, 8059, 8069, 8081, 8087, 8089, 8093, 8101, 8111, &
8117, 8123, 8147, 8161, 8167, 8171, 8179, 8191, 8209, 8219, &
8221, 8231, 8233, 8237, 8243, 8263, 8269, 8273, 8287, 8291, &
8293, 8297, 8311, 8317, 8329, 8353, 8363, 8369, 8377, 8387, &
8389, 8419, 8423, 8429, 8431, 8443, 8447, 8461, 8467, 8501, &
8513, 8521, 8527, 8537, 8539, 8543, 8563, 8573, 8581, 8597, &
8599, 8609, 8623, 8627, 8629, 8641, 8647, 8663, 8669, 8677, &
8681, 8689, 8693, 8699, 8707, 8713, 8719, 8731, 8737, 8741, &
8747, 8753, 8761, 8779, 8783, 8803, 8807, 8819, 8821, 8831, &
! 1101:1200
8837, 8839, 8849, 8861, 8863, 8867, 8887, 8893, 8923, 8929, &
8933, 8941, 8951, 8963, 8969, 8971, 8999, 9001, 9007, 9011, &
9013, 9029, 9041, 9043, 9049, 9059, 9067, 9091, 9103, 9109, &
9127, 9133, 9137, 9151, 9157, 9161, 9173, 9181, 9187, 9199, &
9203, 9209, 9221, 9227, 9239, 9241, 9257, 9277, 9281, 9283, &
9293, 9311, 9319, 9323, 9337, 9341, 9343, 9349, 9371, 9377, &
9391, 9397, 9403, 9413, 9419, 9421, 9431, 9433, 9437, 9439, &
9461, 9463, 9467, 9473, 9479, 9491, 9497, 9511, 9521, 9533, &
9539, 9547, 9551, 9587, 9601, 9613, 9619, 9623, 9629, 9631, &
9643, 9649, 9661, 9677, 9679, 9689, 9697, 9719, 9721, 9733, &
! 1201:1300
9739, 9743, 9749, 9767, 9769, 9781, 9787, 9791, 9803, 9811, &
9817, 9829, 9833, 9839, 9851, 9857, 9859, 9871, 9883, 9887, &
9901, 9907, 9923, 9929, 9931, 9941, 9949, 9967, 9973, 10007, &
10009, 10037, 10039, 10061, 10067, 10069, 10079, 10091, 10093, 10099, &
10103, 10111, 10133, 10139, 10141, 10151, 10159, 10163, 10169, 10177, &
10181, 10193, 10211, 10223, 10243, 10247, 10253, 10259, 10267, 10271, &
10273, 10289, 10301, 10303, 10313, 10321, 10331, 10333, 10337, 10343, &
10357, 10369, 10391, 10399, 10427, 10429, 10433, 10453, 10457, 10459, &
10463, 10477, 10487, 10499, 10501, 10513, 10529, 10531, 10559, 10567, &
10589, 10597, 10601, 10607, 10613, 10627, 10631, 10639, 10651, 10657, &
! 1301:1400
10663, 10667, 10687, 10691, 10709, 10711, 10723, 10729, 10733, 10739, &
10753, 10771, 10781, 10789, 10799, 10831, 10837, 10847, 10853, 10859, &
10861, 10867, 10883, 10889, 10891, 10903, 10909, 19037, 10939, 10949, &
10957, 10973, 10979, 10987, 10993, 11003, 11027, 11047, 11057, 11059, &
11069, 11071, 11083, 11087, 11093, 11113, 11117, 11119, 11131, 11149, &
11159, 11161, 11171, 11173, 11177, 11197, 11213, 11239, 11243, 11251, &
11257, 11261, 11273, 11279, 11287, 11299, 11311, 11317, 11321, 11329, &
11351, 11353, 11369, 11383, 11393, 11399, 11411, 11423, 11437, 11443, &
11447, 11467, 11471, 11483, 11489, 11491, 11497, 11503, 11519, 11527, &
11549, 11551, 11579, 11587, 11593, 11597, 11617, 11621, 11633, 11657, &
! 1401:1500
11677, 11681, 11689, 11699, 11701, 11717, 11719, 11731, 11743, 11777, &
11779, 11783, 11789, 11801, 11807, 11813, 11821, 11827, 11831, 11833, &
11839, 11863, 11867, 11887, 11897, 11903, 11909, 11923, 11927, 11933, &
11939, 11941, 11953, 11959, 11969, 11971, 11981, 11987, 12007, 12011, &
12037, 12041, 12043, 12049, 12071, 12073, 12097, 12101, 12107, 12109, &
12113, 12119, 12143, 12149, 12157, 12161, 12163, 12197, 12203, 12211, &
12227, 12239, 12241, 12251, 12253, 12263, 12269, 12277, 12281, 12289, &
12301, 12323, 12329, 12343, 12347, 12373, 12377, 12379, 12391, 12401, &
12409, 12413, 12421, 12433, 12437, 12451, 12457, 12473, 12479, 12487, &
12491, 12497, 12503, 12511, 12517, 12527, 12539, 12541, 12547, 12553],pInt)
if (n < size(npvec)) then
prime = npvec(n)
else
call IO_error(error_ID=406_pInt)
end if
end function prime
end subroutine halton_memory
!--------------------------------------------------------------------------------------------------
!> @brief sets the dimension for a Halton sequence
!> @author John Burkardt
!--------------------------------------------------------------------------------------------------
subroutine halton_ndim_set(ndim)
implicit none
integer(pInt), intent(in) :: ndim !< dimension of the Halton vectors
integer(pInt) :: value_halton(1)
value_halton(1) = ndim
call halton_memory ('SET', 'NDIM', 1_pInt, value_halton)
end subroutine halton_ndim_set
!--------------------------------------------------------------------------------------------------
!> @brief sets the seed for the Halton sequence.
!> @details Calling HALTON repeatedly returns the elements of the Halton sequence in order,
!> @details starting with element number 1.
!> @details An internal counter, called SEED, keeps track of the next element to return. Each time
!> @details is computed, and then SEED is incremented by 1.
!> @details To restart the Halton sequence, it is only necessary to reset SEED to 1. It might also
!> @details be desirable to reset SEED to some other value. This routine allows the user to specify
!> @details any value of SEED.
!> @details The default value of SEED is 1, which restarts the Halton sequence.
!> @author John Burkardt
!--------------------------------------------------------------------------------------------------
subroutine halton_seed_set(seed)
implicit none
integer(pInt), parameter :: NDIM = 1_pInt
integer(pInt), intent(in) :: seed !< seed for the Halton sequence.
integer(pInt) :: value_halton(ndim)
value_halton(1) = seed
call halton_memory ('SET', 'SEED', NDIM, value_halton)
end subroutine halton_seed_set
end function halton
!--------------------------------------------------------------------------------------------------

12
src/mesh.f90
View File

@ -118,11 +118,6 @@ module mesh
logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information
#endif
#ifdef Spectral
#include <petsc/finclude/petscsys.h>
include 'fftw3-mpi.f03'
#endif
! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS)
! Hence, I suggest to prefix with "FE_"
@ -481,6 +476,10 @@ subroutine mesh_init(ip,el)
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
#ifdef Spectral
#include <petsc/finclude/petscsys.h>
use PETScsys
#endif
use DAMASK_interface
use IO, only: &
@ -516,6 +515,7 @@ subroutine mesh_init(ip,el)
implicit none
#ifdef Spectral
include 'fftw3-mpi.f03'
integer(C_INTPTR_T) :: devNull, local_K, local_K_offset
integer :: ierr, worldsize
#endif
@ -524,8 +524,6 @@ subroutine mesh_init(ip,el)
integer(pInt) :: j
logical :: myDebug
external :: MPI_comm_size
write(6,'(/,a)') ' <<<+- mesh init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"

13
src/numerics.f90
View File

@ -10,9 +10,6 @@ module numerics
implicit none
private
#ifdef PETSc
#include <petsc/finclude/petsc.h90>
#endif
character(len=64), parameter, private :: &
numerics_CONFIGFILE = 'numerics.config' !< name of configuration file
@ -111,7 +108,7 @@ module numerics
character(len=64), private :: &
fftw_plan_mode = 'FFTW_PATIENT' !< reads the planing-rigor flag, see manual on www.fftw.org, Default FFTW_PATIENT: use patient planner flag
character(len=64), protected, public :: &
spectral_solver = 'basicpetsc' , & !< spectral solution method
spectral_solver = 'basic', & !< spectral solution method
spectral_derivative = 'continuous' !< spectral spatial derivative method
character(len=1024), protected, public :: &
petsc_defaultOptions = '-mech_snes_type ngmres &
@ -216,6 +213,10 @@ subroutine numerics_init
IO_warning, &
IO_timeStamp, &
IO_EOF
#ifdef PETSc
#include <petsc/finclude/petscsys.h>
use petscsys
#endif
#if defined(Spectral) || defined(FEM)
!$ use OMP_LIB, only: omp_set_num_threads ! Use the standard conforming module file for omp if using the spectral solver
implicit none
@ -232,9 +233,7 @@ subroutine numerics_init
line
!$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS
external :: &
MPI_Comm_rank, &
MPI_Comm_size, &
MPI_Abort
PETScErrorF ! is called in the CHKERRQ macro
#ifdef PETSc
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr)

3
src/plastic_disloUCLA.f90
View File

@ -152,7 +152,8 @@ subroutine plastic_disloUCLA_init(fileUnit)
PLASTICITY_DISLOUCLA_label, &
PLASTICITY_DISLOUCLA_ID, &
material_phase, &
plasticState, &
plasticState
use config, only: &
MATERIAL_partPhase
use lattice
use numerics,only: &

3
src/plastic_dislotwin.f90
View File

@ -239,7 +239,8 @@ subroutine plastic_dislotwin_init(fileUnit)
PLASTICITY_DISLOTWIN_label, &
PLASTICITY_DISLOTWIN_ID, &
material_phase, &
plasticState, &
plasticState
use config, only: &
MATERIAL_partPhase
use lattice
use numerics,only: &

386
src/plastic_isotropic.f90
View File

@ -13,15 +13,10 @@ module plastic_isotropic
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
plastic_isotropic_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
plastic_isotropic_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
plastic_isotropic_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
plastic_isotropic_Noutput !< number of outputs per instance
@ -40,20 +35,20 @@ module plastic_isotropic
gdot0, &
n, &
h0, &
h0_slopeLnRate = 0.0_pReal, &
h0_slopeLnRate, &
tausat, &
a, &
aTolFlowstress = 1.0_pReal, &
aTolShear = 1.0e-6_pReal, &
tausat_SinhFitA= 0.0_pReal, &
tausat_SinhFitB= 0.0_pReal, &
tausat_SinhFitC= 0.0_pReal, &
tausat_SinhFitD= 0.0_pReal
aTolFlowstress, &
aTolShear, &
tausat_SinhFitA, &
tausat_SinhFitB, &
tausat_SinhFitC, &
tausat_SinhFitD
logical :: &
dilatation = .false.
dilatation
end type
type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance)
type(tParameters), dimension(:), allocatable, target, private :: param !< containers of constitutive parameters (len Ninstance)
type, private :: tIsotropicState !< internal state aliases
real(pReal), pointer, dimension(:) :: & ! scalars along NipcMyInstance
@ -61,20 +56,10 @@ module plastic_isotropic
accumulatedShear
end type
type, private :: tIsotropicAbsTol !< internal alias for abs tolerance in state
real(pReal), pointer :: & ! scalars
flowstress, &
accumulatedShear
end type
type(tIsotropicState), allocatable, dimension(:), private :: & !< state aliases per instance
state, &
state0, &
dotState
type(tIsotropicAbsTol), allocatable, dimension(:), private :: & !< state aliases per instance
stateAbsTol
public :: &
plastic_isotropic_init, &
plastic_isotropic_LpAndItsTangent, &
@ -89,12 +74,13 @@ contains
!> @brief module initialization
!> @details reads in material parameters, allocates arrays, and does sanity checks
!--------------------------------------------------------------------------------------------------
subroutine plastic_isotropic_init(fileUnit)
subroutine plastic_isotropic_init()
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
compiler_options
#endif
use IO
use debug, only: &
debug_level, &
debug_constitutive, &
@ -104,17 +90,6 @@ subroutine plastic_isotropic_init(fileUnit)
use math, only: &
math_Mandel3333to66, &
math_Voigt66to3333
use IO, only: &
IO_read, &
IO_lc, &
IO_getTag, &
IO_isBlank, &
IO_stringPos, &
IO_stringValue, &
IO_floatValue, &
IO_error, &
IO_timeStamp, &
IO_EOF
use material, only: &
phase_plasticity, &
phase_plasticityInstance, &
@ -122,16 +97,17 @@ subroutine plastic_isotropic_init(fileUnit)
PLASTICITY_ISOTROPIC_label, &
PLASTICITY_ISOTROPIC_ID, &
material_phase, &
plasticState, &
MATERIAL_partPhase
plasticState
use config, only: &
MATERIAL_partPhase, &
config_phase
use lattice
implicit none
integer(pInt), intent(in) :: fileUnit
type(tParameters), pointer :: prm
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(pInt) :: &
o, &
phase, &
@ -142,180 +118,103 @@ subroutine plastic_isotropic_init(fileUnit)
sizeState, &
sizeDeltaState
character(len=65536) :: &
tag = '', &
line = '', &
extmsg = ''
character(len=64) :: &
outputtag = ''
integer(pInt) :: NipcMyPhase
integer(pInt) :: NipcMyPhase,i
character(len=65536), dimension(:), allocatable :: outputs
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_ISOTROPIC_label//' init -+>>>'
write(6,'(/,a)') ' Ma et al., Computational Materials Science, 109:323–329, 2015'
write(6,'(/,a)') ' https://doi.org/10.1016/j.commatsci.2015.07.041'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
maxNinstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt)
if (maxNinstance == 0_pInt) return
if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
allocate(plastic_isotropic_sizePostResults(maxNinstance), source=0_pInt)
! public variables
allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt)
allocate(plastic_isotropic_output(maxval(phase_Noutput), maxNinstance))
plastic_isotropic_output = ''
allocate(plastic_isotropic_Noutput(maxNinstance), source=0_pInt)
! inernal variable
allocate(param(maxNinstance)) ! one container of parameters per instance
rewind(fileUnit)
phase = 0_pInt
do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to <phase>
line = IO_read(fileUnit)
enddo
parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part
line = IO_read(fileUnit)
if (IO_isBlank(line)) cycle ! skip empty lines
if (IO_getTag(line,'<','>') /= '') then ! stop at next part
line = IO_read(fileUnit, .true.) ! reset IO_read
exit
endif
if (IO_getTag(line,'[',']') /= '') then ! next section
phase = phase + 1_pInt ! advance section counter
if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then
instance = phase_plasticityInstance(phase) ! count instances of my constitutive law
allocate(param(instance)%outputID(phase_Noutput(phase))) ! allocate space for IDs of every requested output
endif
cycle ! skip to next line
endif
if (phase > 0_pInt) then; if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran
instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
select case(outputtag)
case ('flowstress')
plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
param(instance)%outputID (plastic_isotropic_Noutput(instance)) = flowstress_ID
plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputtag
case ('strainrate')
plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
param(instance)%outputID (plastic_isotropic_Noutput(instance)) = strainrate_ID
plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputtag
end select
case ('/dilatation/')
param(instance)%dilatation = .true.
case ('tau0')
param(instance)%tau0 = IO_floatValue(line,chunkPos,2_pInt)
case ('gdot0')
param(instance)%gdot0 = IO_floatValue(line,chunkPos,2_pInt)
case ('n')
param(instance)%n = IO_floatValue(line,chunkPos,2_pInt)
case ('h0')
param(instance)%h0 = IO_floatValue(line,chunkPos,2_pInt)
case ('h0_slope','slopelnrate')
param(instance)%h0_slopeLnRate = IO_floatValue(line,chunkPos,2_pInt)
case ('tausat')
param(instance)%tausat = IO_floatValue(line,chunkPos,2_pInt)
case ('tausat_sinhfita')
param(instance)%tausat_SinhFitA = IO_floatValue(line,chunkPos,2_pInt)
case ('tausat_sinhfitb')
param(instance)%tausat_SinhFitB = IO_floatValue(line,chunkPos,2_pInt)
case ('tausat_sinhfitc')
param(instance)%tausat_SinhFitC = IO_floatValue(line,chunkPos,2_pInt)
case ('tausat_sinhfitd')
param(instance)%tausat_SinhFitD = IO_floatValue(line,chunkPos,2_pInt)
case ('a', 'w0')
param(instance)%a = IO_floatValue(line,chunkPos,2_pInt)
case ('taylorfactor')
param(instance)%fTaylor = IO_floatValue(line,chunkPos,2_pInt)
case ('atol_flowstress')
param(instance)%aTolFlowstress = IO_floatValue(line,chunkPos,2_pInt)
case ('atol_shear')
param(instance)%aTolShear = IO_floatValue(line,chunkPos,2_pInt)
case default
end select
endif; endif
enddo parsingFile
allocate(state(maxNinstance)) ! internal state aliases
allocate(state0(maxNinstance))
allocate(dotState(maxNinstance))
allocate(stateAbsTol(maxNinstance))
initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop over every plasticity
myPhase: if (phase_plasticity(phase) == PLASTICITY_isotropic_ID) then ! isolate instances of own constitutive description
NipcMyPhase = count(material_phase == phase) ! number of own material points (including point components ipc)
do phase = 1_pInt, size(phase_plasticityInstance)
if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then
instance = phase_plasticityInstance(phase)
extmsg = ''
prm => param(instance) ! shorthand pointer to parameter object of my constitutive law
prm%tau0 = config_phase(phase)%getFloat('tau0')
prm%tausat = config_phase(phase)%getFloat('tausat')
prm%gdot0 = config_phase(phase)%getFloat('gdot0')
prm%n = config_phase(phase)%getFloat('n')
prm%h0 = config_phase(phase)%getFloat('h0')
prm%fTaylor = config_phase(phase)%getFloat('m')
prm%h0_slopeLnRate = config_phase(phase)%getFloat('h0_slopelnrate', defaultVal=0.0_pReal)
prm%tausat_SinhFitA = config_phase(phase)%getFloat('tausat_sinhfita',defaultVal=0.0_pReal)
prm%tausat_SinhFitB = config_phase(phase)%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal)
prm%tausat_SinhFitC = config_phase(phase)%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal)
prm%tausat_SinhFitD = config_phase(phase)%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal)
prm%a = config_phase(phase)%getFloat('a')
prm%aTolFlowStress = config_phase(phase)%getFloat('atol_flowstress',defaultVal=1.0_pReal)
prm%aTolShear = config_phase(phase)%getFloat('atol_shear',defaultVal=1.0e-6_pReal)
prm%dilatation = config_phase(phase)%keyExists('/dilatation/')
#if defined(__GFORTRAN__)
outputs = ['GfortranBug86277']
outputs = config_phase(phase)%getStrings('(output)',defaultVal=outputs)
if (outputs(1) == 'GfortranBug86277') outputs = [character(len=65536)::]
#else
outputs = config_phase(phase)%getStrings('(output)',defaultVal=[character(len=65536)::])
#endif
allocate(prm%outputID(0))
do i=1_pInt, size(outputs)
select case(outputs(i))
case ('flowstress')
plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i)
plasticState(phase)%sizePostResults = plasticState(phase)%sizePostResults + 1_pInt
plastic_isotropic_sizePostResult(i,instance) = 1_pInt
prm%outputID = [prm%outputID,flowstress_ID]
case ('strainrate')
plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i)
plasticState(phase)%sizePostResults = &
plasticState(phase)%sizePostResults + 1_pInt
plastic_isotropic_sizePostResult(i,instance) = 1_pInt
prm%outputID = [prm%outputID,strainrate_ID]
end select
enddo
!--------------------------------------------------------------------------------------------------
! sanity checks
if (param(instance)%aTolShear <= 0.0_pReal) param(instance)%aTolShear = 1.0e-6_pReal ! default absolute tolerance 1e-6
if (param(instance)%tau0 < 0.0_pReal) extmsg = trim(extmsg)//' tau0'
if (param(instance)%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0'
if (param(instance)%n <= 0.0_pReal) extmsg = trim(extmsg)//' n'
if (param(instance)%tausat <= 0.0_pReal) extmsg = trim(extmsg)//' tausat'
if (param(instance)%a <= 0.0_pReal) extmsg = trim(extmsg)//' a'
if (param(instance)%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//' taylorfactor'
if (param(instance)%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_flowstress'
if (extmsg /= '') then
extmsg = trim(extmsg)//' ('//PLASTICITY_ISOTROPIC_label//')' ! prepare error message identifier
call IO_error(211_pInt,ip=instance,ext_msg=extmsg)
endif
!--------------------------------------------------------------------------------------------------
! Determine size of postResults array
outputsLoop: do o = 1_pInt,plastic_isotropic_Noutput(instance)
select case(param(instance)%outputID(o))
case(flowstress_ID,strainrate_ID)
mySize = 1_pInt
case default
end select
outputFound: if (mySize > 0_pInt) then
plastic_isotropic_sizePostResult(o,instance) = mySize
plastic_isotropic_sizePostResults(instance) = &
plastic_isotropic_sizePostResults(instance) + mySize
endif outputFound
enddo outputsLoop
extmsg = ''
if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"'aTolShear' "
if (prm%tau0 < 0.0_pReal) extmsg = trim(extmsg)//"'tau0' "
if (prm%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//"'gdot0' "
if (prm%n <= 0.0_pReal) extmsg = trim(extmsg)//"'n' "
if (prm%tausat <= prm%tau0) extmsg = trim(extmsg)//"'tausat' "
if (prm%a <= 0.0_pReal) extmsg = trim(extmsg)//"'a' "
if (prm%fTaylor <= 0.0_pReal) extmsg = trim(extmsg)//"'m' "
if (prm%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//"'atol_flowstress' "
if (extmsg /= '') call IO_error(211_pInt,ip=instance,&
ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')')
!--------------------------------------------------------------------------------------------------
! allocate state arrays
sizeDotState = 2_pInt ! flowstress, accumulated_shear
NipcMyPhase = count(material_phase == phase) ! number of own material points (including point components ipc)
sizeDotState = size(["flowstress ","accumulated_shear"])
sizeDeltaState = 0_pInt ! no sudden jumps in state
sizeState = sizeDotState + sizeDeltaState
plasticState(phase)%sizeState = sizeState
plasticState(phase)%sizeDotState = sizeDotState
plasticState(phase)%sizeDeltaState = sizeDeltaState
plasticState(phase)%sizePostResults = plastic_isotropic_sizePostResults(instance)
plasticState(phase)%nSlip = 1
plasticState(phase)%nTwin = 0
plasticState(phase)%nTrans= 0
allocate(plasticState(phase)%aTolState ( sizeState))
allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase),source=0.0_pReal)
allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase),source=0.0_pReal)
allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase),source=0.0_pReal)
allocate(plasticState(phase)%state ( sizeState,NipcMyPhase),source=0.0_pReal)
@ -331,37 +230,27 @@ subroutine plastic_isotropic_init(fileUnit)
allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase),source=0.0_pReal)
!--------------------------------------------------------------------------------------------------
! globally required state aliases
! locally defined state aliases and initialization of state0 and aTolState
state(instance)%flowstress => plasticState(phase)%state (1,1:NipcMyPhase)
dotState(instance)%flowstress => plasticState(phase)%dotState (1,1:NipcMyPhase)
plasticState(phase)%state0(1,1:NipcMyPhase) = prm%tau0
plasticState(phase)%aTolState(1) = prm%aTolFlowstress
state(instance)%accumulatedShear => plasticState(phase)%state (2,1:NipcMyPhase)
dotState(instance)%accumulatedShear => plasticState(phase)%dotState (2,1:NipcMyPhase)
plasticState(phase)%state0 (2,1:NipcMyPhase) = 0.0_pReal
plasticState(phase)%aTolState(2) = prm%aTolShear
! global alias
plasticState(phase)%slipRate => plasticState(phase)%dotState(2:2,1:NipcMyPhase)
plasticState(phase)%accumulatedSlip => plasticState(phase)%state (2:2,1:NipcMyPhase)
!--------------------------------------------------------------------------------------------------
! locally defined state aliases
state(instance)%flowstress => plasticState(phase)%state (1,1:NipcMyPhase)
state0(instance)%flowstress => plasticState(phase)%state0 (1,1:NipcMyPhase)
dotState(instance)%flowstress => plasticState(phase)%dotState (1,1:NipcMyPhase)
stateAbsTol(instance)%flowstress => plasticState(phase)%aTolState(1)
state(instance)%accumulatedShear => plasticState(phase)%state (2,1:NipcMyPhase)
state0(instance)%accumulatedShear => plasticState(phase)%state0 (2,1:NipcMyPhase)
dotState(instance)%accumulatedShear => plasticState(phase)%dotState (2,1:NipcMyPhase)
stateAbsTol(instance)%accumulatedShear => plasticState(phase)%aTolState(2)
!--------------------------------------------------------------------------------------------------
! init state
state0(instance)%flowstress = param(instance)%tau0
state0(instance)%accumulatedShear = 0.0_pReal
!--------------------------------------------------------------------------------------------------
! init absolute state tolerances
stateAbsTol(instance)%flowstress = param(instance)%aTolFlowstress
stateAbsTol(instance)%accumulatedShear = param(instance)%aTolShear
endif myPhase
enddo initializeInstances
endif
enddo
end subroutine plastic_isotropic_init
!--------------------------------------------------------------------------------------------------
!> @brief calculates plastic velocity gradient and its tangent
!--------------------------------------------------------------------------------------------------
@ -380,8 +269,7 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el)
math_Mandel6to33, &
math_Plain3333to99, &
math_deviatoric33, &
math_mul33xx33, &
math_transpose33
math_mul33xx33
use material, only: &
phasememberAt, &
material_phase, &
@ -400,6 +288,8 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el)
ip, & !< integration point
el !< element
type(tParameters), pointer :: prm
real(pReal), dimension(3,3) :: &
Tstar_dev_33 !< deviatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor
real(pReal), dimension(3,3,3,3) :: &
@ -414,6 +304,7 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el)
of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
prm => param(instance)
Tstar_dev_33 = math_deviatoric33(math_Mandel6to33(Tstar_v)) ! deviatoric part of 2nd Piola-Kirchhoff stress
squarenorm_Tstar_dev = math_mul33xx33(Tstar_dev_33,Tstar_dev_33)
@ -423,31 +314,31 @@ subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el)
Lp = 0.0_pReal
dLp_dTstar99 = 0.0_pReal
else
gamma_dot = param(instance)%gdot0 &
* ( sqrt(1.5_pReal) * norm_Tstar_dev / param(instance)%fTaylor / state(instance)%flowstress(of) ) &
**param(instance)%n
gamma_dot = prm%gdot0 &
* ( sqrt(1.5_pReal) * norm_Tstar_dev / prm%fTaylor / state(instance)%flowstress(of) ) &
**prm%n
Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/param(instance)%fTaylor
Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/prm%fTaylor
if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt &
.and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
.or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then
write(6,'(a,i8,1x,i2,1x,i3)') '<< CONST isotropic >> at el ip g ',el,ip,ipc
write(6,'(/,a,/,3(12x,3(f12.4,1x)/))') '<< CONST isotropic >> Tstar (dev) / MPa', &
math_transpose33(Tstar_dev_33(1:3,1:3))*1.0e-6_pReal
transpose(Tstar_dev_33(1:3,1:3))*1.0e-6_pReal
write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> norm Tstar / MPa', norm_Tstar_dev*1.0e-6_pReal
write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', gamma_dot
end if
!--------------------------------------------------------------------------------------------------
! Calculation of the tangent of Lp
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLp_dTstar_3333(k,l,m,n) = (param(instance)%n-1.0_pReal) * &
dLp_dTstar_3333(k,l,m,n) = (prm%n-1.0_pReal) * &
Tstar_dev_33(k,l)*Tstar_dev_33(m,n) / squarenorm_Tstar_dev
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) &
dLp_dTstar_3333(k,l,k,l) = dLp_dTstar_3333(k,l,k,l) + 1.0_pReal
forall (k=1_pInt:3_pInt,m=1_pInt:3_pInt) &
dLp_dTstar_3333(k,k,m,m) = dLp_dTstar_3333(k,k,m,m) - 1.0_pReal/3.0_pReal
dLp_dTstar99 = math_Plain3333to99(gamma_dot / param(instance)%fTaylor * &
dLp_dTstar99 = math_Plain3333to99(gamma_dot / prm%fTaylor * &
dLp_dTstar_3333 / norm_Tstar_dev)
end if
end subroutine plastic_isotropic_LpAndItsTangent
@ -479,9 +370,11 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar_3333,Tstar_v,ipc,ip,e
ip, & !< integration point
el !< element
type(tParameters), pointer :: prm
real(pReal), dimension(3,3) :: &
Tstar_sph_33 !< sphiatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor
real(pReal) :: &
real(pReal) :: &
gamma_dot, & !< strainrate
norm_Tstar_sph, & !< euclidean norm of Tstar_sph
squarenorm_Tstar_sph !< square of the euclidean norm of Tstar_sph
@ -491,34 +384,34 @@ real(pReal) :: &
of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
prm => param(instance)
Tstar_sph_33 = math_spherical33(math_Mandel6to33(Tstar_v)) ! spherical part of 2nd Piola-Kirchhoff stress
squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph_33,Tstar_sph_33)
norm_Tstar_sph = sqrt(squarenorm_Tstar_sph)
if (param(instance)%dilatation .and. norm_Tstar_sph > 0.0_pReal) then ! Tstar == 0 or J2 plascitiy --> both Li and dLi_dTstar are zero
gamma_dot = param(instance)%gdot0 &
* (sqrt(1.5_pReal) * norm_Tstar_sph / param(instance)%fTaylor / state(instance)%flowstress(of) ) &
**param(instance)%n
if (prm%dilatation .and. norm_Tstar_sph > 0.0_pReal) then ! Tstar == 0 or J2 plascitiy --> both Li and dLi_dTstar are zero
gamma_dot = prm%gdot0 &
* (sqrt(1.5_pReal) * norm_Tstar_sph / prm%fTaylor / state(instance)%flowstress(of) ) &
**prm%n
Li = Tstar_sph_33/norm_Tstar_sph * gamma_dot/param(instance)%fTaylor
Li = Tstar_sph_33/norm_Tstar_sph * gamma_dot/prm%fTaylor
!--------------------------------------------------------------------------------------------------
! Calculation of the tangent of Li
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
dLi_dTstar_3333(k,l,m,n) = (param(instance)%n-1.0_pReal) * &
dLi_dTstar_3333(k,l,m,n) = (prm%n-1.0_pReal) * &
Tstar_sph_33(k,l)*Tstar_sph_33(m,n) / squarenorm_Tstar_sph
forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt) &
dLi_dTstar_3333(k,l,k,l) = dLi_dTstar_3333(k,l,k,l) + 1.0_pReal
dLi_dTstar_3333 = gamma_dot / param(instance)%fTaylor * &
dLi_dTstar_3333 = gamma_dot / prm%fTaylor * &
dLi_dTstar_3333 / norm_Tstar_sph
else
Li = 0.0_pReal
dLi_dTstar_3333 = 0.0_pReal
endif
end subroutine plastic_isotropic_LiAndItsTangent
end subroutine plastic_isotropic_LiAndItsTangent
!--------------------------------------------------------------------------------------------------
@ -541,6 +434,7 @@ subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el)
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
type(tParameters), pointer :: prm
real(pReal), dimension(6) :: &
Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation
real(pReal) :: &
@ -554,10 +448,11 @@ subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el)
of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
prm => param(instance)
!--------------------------------------------------------------------------------------------------
! norm of (deviatoric) 2nd Piola-Kirchhoff stress
if (param(instance)%dilatation) then
if (prm%dilatation) then
norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v))
else
Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal
@ -566,26 +461,26 @@ subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el)
end if
!--------------------------------------------------------------------------------------------------
! strain rate
gamma_dot = param(instance)%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v &
gamma_dot = prm%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v &
/ &!-----------------------------------------------------------------------------------
(param(instance)%fTaylor*state(instance)%flowstress(of) ))**param(instance)%n
(prm%fTaylor*state(instance)%flowstress(of) ))**prm%n
!--------------------------------------------------------------------------------------------------
! hardening coefficient
if (abs(gamma_dot) > 1e-12_pReal) then
if (dEq0(param(instance)%tausat_SinhFitA)) then
saturation = param(instance)%tausat
if (dEq0(prm%tausat_SinhFitA)) then
saturation = prm%tausat
else
saturation = param(instance)%tausat &
+ asinh( (gamma_dot / param(instance)%tausat_SinhFitA&
)**(1.0_pReal / param(instance)%tausat_SinhFitD)&
)**(1.0_pReal / param(instance)%tausat_SinhFitC) &
/ ( param(instance)%tausat_SinhFitB &
* (gamma_dot / param(instance)%gdot0)**(1.0_pReal / param(instance)%n) &
saturation = prm%tausat &
+ asinh( (gamma_dot / prm%tausat_SinhFitA&
)**(1.0_pReal / prm%tausat_SinhFitD)&
)**(1.0_pReal / prm%tausat_SinhFitC) &
/ ( prm%tausat_SinhFitB &
* (gamma_dot / prm%gdot0)**(1.0_pReal / prm%n) &
)
endif
hardening = ( param(instance)%h0 + param(instance)%h0_slopeLnRate * log(gamma_dot) ) &
* abs( 1.0_pReal - state(instance)%flowstress(of)/saturation )**param(instance)%a &
hardening = ( prm%h0 + prm%h0_slopeLnRate * log(gamma_dot) ) &
* abs( 1.0_pReal - state(instance)%flowstress(of)/saturation )**prm%a &
* sign(1.0_pReal, 1.0_pReal - state(instance)%flowstress(of)/saturation)
else
hardening = 0.0_pReal
@ -603,6 +498,7 @@ function plastic_isotropic_postResults(Tstar_v,ipc,ip,el)
use math, only: &
math_mul6x6
use material, only: &
plasticState, &
material_phase, &
phasememberAt, &
phase_plasticityInstance
@ -614,7 +510,10 @@ function plastic_isotropic_postResults(Tstar_v,ipc,ip,el)
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), dimension(plastic_isotropic_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
type(tParameters), pointer :: prm
real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: &
plastic_isotropic_postResults
real(pReal), dimension(6) :: &
@ -629,10 +528,11 @@ function plastic_isotropic_postResults(Tstar_v,ipc,ip,el)
of = phasememberAt(ipc,ip,el) ! phasememberAt should be tackled by material and be renamed to material_phasemember
instance = phase_plasticityInstance(material_phase(ipc,ip,el))
prm => param(instance)
!--------------------------------------------------------------------------------------------------
! norm of (deviatoric) 2nd Piola-Kirchhoff stress
if (param(instance)%dilatation) then
if (prm%dilatation) then
norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v))
else
Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal
@ -644,15 +544,15 @@ function plastic_isotropic_postResults(Tstar_v,ipc,ip,el)
plastic_isotropic_postResults = 0.0_pReal
outputsLoop: do o = 1_pInt,plastic_isotropic_Noutput(instance)
select case(param(instance)%outputID(o))
select case(prm%outputID(o))
case (flowstress_ID)
plastic_isotropic_postResults(c+1_pInt) = state(instance)%flowstress(of)
c = c + 1_pInt
case (strainrate_ID)
plastic_isotropic_postResults(c+1_pInt) = &
param(instance)%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v &
prm%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v &
/ &!----------------------------------------------------------------------------------
(param(instance)%fTaylor * state(instance)%flowstress(of)) ) ** param(instance)%n
(prm%fTaylor * state(instance)%flowstress(of)) ) ** prm%n
c = c + 1_pInt
end select
enddo outputsLoop

121
src/plastic_kinematichardening.f90
View File

@ -1,6 +1,7 @@
!--------------------------------------------------------------------------------------------------
!> @author Philip Eisenlohr, Michigan State University
!> @author Zhuowen Zhao, Michigan State University
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Introducing Voce-type kinematic hardening rule into crystal plasticity
!! formulation using a power law fitting
!--------------------------------------------------------------------------------------------------
@ -12,32 +13,32 @@ module plastic_kinehardening
implicit none
private
integer(pInt), dimension(:), allocatable, public, protected :: &
plastic_kinehardening_sizePostResults !< cumulative size of post results
plastic_kinehardening_sizePostResults !< cumulative size of post results
integer(pInt), dimension(:,:), allocatable, target, public :: &
plastic_kinehardening_sizePostResult !< size of each post result output
plastic_kinehardening_sizePostResult !< size of each post result output
character(len=64), dimension(:,:), allocatable, target, public :: &
plastic_kinehardening_output !< name of each post result output
plastic_kinehardening_output !< name of each post result output
integer(pInt), dimension(:), allocatable, target, public :: &
plastic_kinehardening_Noutput !< number of outputs per instance
plastic_kinehardening_Noutput !< number of outputs per instance
integer(pInt), dimension(:), allocatable, public, protected :: &
plastic_kinehardening_totalNslip !< no. of slip system used in simulation
plastic_kinehardening_totalNslip !< no. of slip system used in simulation
integer(pInt), dimension(:,:), allocatable, private :: &
plastic_kinehardening_Nslip !< active number of slip systems per family (input parameter, per family)
plastic_kinehardening_Nslip !< active number of slip systems per family (input parameter, per family)
enum, bind(c)
enumerator :: undefined_ID, &
crss_ID, & !< critical resolved stress
crss_back_ID, & !< critical resolved back stress
sense_ID, & !< sense of acting shear stress (-1 or +1)
chi0_ID, & !< backstress at last switch of stress sense (positive?)
gamma0_ID, & !< accumulated shear at last switch of stress sense (at current switch?)
crss_ID, & !< critical resolved stress
crss_back_ID, & !< critical resolved back stress
sense_ID, & !< sense of acting shear stress (-1 or +1)
chi0_ID, & !< backstress at last switch of stress sense (positive?)
gamma0_ID, & !< accumulated shear at last switch of stress sense (at current switch?)
accshear_ID, &
sumGamma_ID, &
shearrate_ID, &
@ -46,26 +47,26 @@ module plastic_kinehardening
end enum
type, private :: tParameters !< container type for internal constitutive parameters
type, private :: tParameters !< container type for internal constitutive parameters
integer(kind(undefined_ID)), dimension(:), allocatable, private :: &
outputID !< ID of each post result output
outputID !< ID of each post result output
real(pReal) :: &
gdot0, & !< reference shear strain rate for slip (input parameter)
n_slip, & !< stress exponent for slip (input parameter)
gdot0, & !< reference shear strain rate for slip (input parameter)
n_slip, & !< stress exponent for slip (input parameter)
aTolResistance, &
aTolShear
real(pReal), dimension(:), allocatable, private :: &
crss0, & !< initial critical shear stress for slip (input parameter, per family)
theta0, & !< initial hardening rate of forward stress for each slip
theta1, & !< asymptotic hardening rate of forward stress for each slip >
theta0_b, & !< initial hardening rate of back stress for each slip >
theta1_b, & !< asymptotic hardening rate of back stress for each slip >
crss0, & !< initial critical shear stress for slip (input parameter, per family)
theta0, & !< initial hardening rate of forward stress for each slip
theta1, & !< asymptotic hardening rate of forward stress for each slip >
theta0_b, & !< initial hardening rate of back stress for each slip >
theta1_b, & !< asymptotic hardening rate of back stress for each slip >
tau1, &
tau1_b, &
interaction_slipslip, & !< latent hardening matrix
interaction_slipslip, & !< latent hardening matrix
nonSchmidCoeff
real(pReal), dimension(:,:), allocatable, private :: &
@ -73,20 +74,20 @@ module plastic_kinehardening
end type
type, private :: tKinehardeningState
real(pReal), pointer, dimension(:,:) :: & !< vectors along NipcMyInstance
crss, & !< critical resolved stress
crss_back, & !< critical resolved back stress
sense, & !< sense of acting shear stress (-1 or +1)
chi0, & !< backstress at last switch of stress sense
gamma0, & !< accumulated shear at last switch of stress sense
accshear !< accumulated (absolute) shear
real(pReal), pointer, dimension(:,:) :: & !< vectors along NipcMyInstance
crss, & !< critical resolved stress
crss_back, & !< critical resolved back stress
sense, & !< sense of acting shear stress (-1 or +1)
chi0, & !< backstress at last switch of stress sense
gamma0, & !< accumulated shear at last switch of stress sense
accshear !< accumulated (absolute) shear
real(pReal), pointer, dimension(:) :: & !< scalars along NipcMyInstance
sumGamma !< accumulated shear across all systems
real(pReal), pointer, dimension(:) :: & !< scalars along NipcMyInstance
sumGamma !< accumulated shear across all systems
end type
type(tParameters), dimension(:), allocatable, private :: &
param !< containers of constitutive parameters (len Ninstance)
param !< containers of constitutive parameters (len Ninstance)
type(tKinehardeningState), allocatable, dimension(:), private :: &
dotState, &
@ -145,7 +146,8 @@ subroutine plastic_kinehardening_init(fileUnit)
phase_plasticityInstance, &
phase_Noutput, &
material_phase, &
plasticState, &
plasticState
use config, only: &
MATERIAL_partPhase
use lattice
use numerics,only: &
@ -155,9 +157,10 @@ subroutine plastic_kinehardening_init(fileUnit)
integer(pInt), intent(in) :: fileUnit
integer(pInt), allocatable, dimension(:) :: chunkPos
integer(kind(undefined_ID)) :: &
output_ID
integer(pInt) :: &
o, j, k, f, &
output_ID, &
phase, &
instance, &
maxNinstance, &
@ -177,8 +180,6 @@ subroutine plastic_kinehardening_init(fileUnit)
tag = '', &
line = '', &
extmsg = ''
character(len=64) :: &
outputtag = ''
write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_KINEHARDENING_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
@ -220,7 +221,6 @@ subroutine plastic_kinehardening_init(fileUnit)
Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase
Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase))
Nchunks_nonSchmid = lattice_NnonSchmid(phase)
allocate(param(instance)%outputID(phase_Noutput(phase)), source=undefined_ID) ! allocate space for IDs of every requested output
allocate(param(instance)%crss0 (Nchunks_SlipFamilies), source=0.0_pReal)
allocate(param(instance)%tau1 (Nchunks_SlipFamilies), source=0.0_pReal)
allocate(param(instance)%tau1_b (Nchunks_SlipFamilies), source=0.0_pReal)
@ -232,43 +232,53 @@ subroutine plastic_kinehardening_init(fileUnit)
allocate(param(instance)%nonSchmidCoeff(Nchunks_nonSchmid), source=0.0_pReal)
if(allocated(tempPerSlip)) deallocate(tempPerSlip)
allocate(tempPerSlip(Nchunks_SlipFamilies))
allocate(param(instance)%outputID(0))
endif
cycle ! skip to next line
endif
if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_KINEHARDENING_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran
instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase
chunkPos = IO_stringPos(line)
tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key
select case(tag)
case ('(output)')
outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
output_ID = undefined_ID
select case(outputtag)
select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
case ('resistance')
output_ID = crss_ID
case ('backstress')
output_ID = crss_back_ID
case ('sense')
output_ID = sense_ID
case ('chi0')
output_ID = chi0_ID
case ('gamma0')
output_ID = gamma0_ID
case ('accumulatedshear')
output_ID = accshear_ID
case ('totalshear')
output_ID = sumGamma_ID
case ('shearrate')
output_ID = shearrate_ID
case ('resolvedstress')
output_ID = resolvedstress_ID
end select
if (output_ID /= undefined_ID) then
plastic_kinehardening_Noutput(instance) = plastic_kinehardening_Noutput(instance) + 1_pInt
plastic_kinehardening_output(plastic_kinehardening_Noutput(instance),instance) = outputtag
param(instance)%outputID (plastic_kinehardening_Noutput(instance)) = output_ID
plastic_kinehardening_output(plastic_kinehardening_Noutput(instance),instance) = &
IO_lc(IO_stringValue(line,chunkPos,2_pInt))
param(instance)%outputID = [param(instance)%outputID, output_ID]
endif
!--------------------------------------------------------------------------------------------------
! parameters depending on number of slip families
case ('nslip')
@ -360,11 +370,11 @@ subroutine plastic_kinehardening_init(fileUnit)
!--------------------------------------------------------------------------------------------------
! sanity checks
if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt &
.and. param(instance)%crss0(1:nSlipFamilies) < 0.0_pReal)) extmsg = trim(extmsg)//' crss0'
if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt &
.and. param(instance)%tau1(1:nSlipFamilies) <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1'
if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt &
if (any(plastic_kinehardening_Nslip (1:nSlipFamilies,instance) > 0_pInt &
.and. param(instance)%crss0 (1:nSlipFamilies) < 0.0_pReal)) extmsg = trim(extmsg)//' crss0'
if (any(plastic_kinehardening_Nslip (1:nSlipFamilies,instance) > 0_pInt &
.and. param(instance)%tau1 (1:nSlipFamilies) <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1'
if (any(plastic_kinehardening_Nslip (1:nSlipFamilies,instance) > 0_pInt &
.and. param(instance)%tau1_b(1:nSlipFamilies) < 0.0_pReal)) extmsg = trim(extmsg)//' tau1_b'
if (param(instance)%gdot0 <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0'
if (param(instance)%n_slip <= 0.0_pReal) extmsg = trim(extmsg)//' n_slip'
@ -619,7 +629,6 @@ subroutine plastic_kinehardening_LpAndItsTangent(Lp,dLp_dTstar99, &
math_transpose33
use lattice, only: &
lattice_Sslip, & !< schmid matrix
lattice_Sslip_v, &
lattice_maxNslipFamily, &
lattice_NslipSystem, &
lattice_NnonSchmid
@ -739,8 +748,6 @@ subroutine plastic_kinehardening_deltaState(Tstar_v,ipc,ip,el)
ipc, & !< component-ID of integration point
ip, & !< integration point
el !< element
real(pReal), dimension(6) :: &
Tstar_dev_v !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation
real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(phaseAt(ipc,ip,el)))) :: &
gdot_pos,gdot_neg, &
tau_pos,tau_neg, &
@ -799,14 +806,10 @@ end subroutine plastic_kinehardening_deltaState
!--------------------------------------------------------------------------------------------------
subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el)
use lattice, only: &
lattice_Sslip_v, &
lattice_maxNslipFamily, &
lattice_NslipSystem, &
lattice_NnonSchmid
lattice_maxNslipFamily
use material, only: &
material_phase, &
phaseAt, phasememberAt, &
plasticState, &
phase_plasticityInstance
implicit none
@ -819,10 +822,8 @@ subroutine plastic_kinehardening_dotState(Tstar_v,ipc,ip,el)
integer(pInt) :: &
instance,ph, &
f,i,j,k, &
index_myFamily,index_otherFamily, &
f,i,j, &
nSlip, &
offset_accshear, &
of
real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &
@ -873,14 +874,12 @@ end subroutine plastic_kinehardening_dotState
function plastic_kinehardening_postResults(Tstar_v,ipc,ip,el)
use material, only: &
material_phase, &
plasticState, &
phaseAt, phasememberAt, &
phase_plasticityInstance
use lattice, only: &
lattice_Sslip_v, &
lattice_maxNslipFamily, &
lattice_NslipSystem, &
lattice_NnonSchmid
lattice_NslipSystem
implicit none
real(pReal), dimension(6), intent(in) :: &
@ -896,7 +895,7 @@ function plastic_kinehardening_postResults(Tstar_v,ipc,ip,el)
integer(pInt) :: &
instance,ph, of, &
nSlip,&
o,f,i,c,j,k, &
o,f,i,c,j,&
index_myFamily
real(pReal), dimension(plastic_kinehardening_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: &

2
src/plastic_nonlocal.f90
View File

@ -291,8 +291,8 @@ use material, only: phase_plasticity, &
PLASTICITY_NONLOCAL_label, &
PLASTICITY_NONLOCAL_ID, &
plasticState, &
MATERIAL_partPhase ,&
material_phase
use config, only: MATERIAL_partPhase
use lattice
use numerics,only: &
numerics_integrator

3
src/plastic_phenopowerlaw.f90
View File

@ -157,7 +157,8 @@ subroutine plastic_phenopowerlaw_init(fileUnit)
PLASTICITY_PHENOPOWERLAW_label, &
PLASTICITY_PHENOPOWERLAW_ID, &
material_phase, &
plasticState, &
plasticState
use config, only: &
MATERIAL_partPhase
use lattice
use numerics,only: &

1
src/porosity_none.f90
View File

@ -27,6 +27,7 @@ subroutine porosity_none_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

11
src/porosity_phasefield.f90
View File

@ -77,11 +77,10 @@ subroutine porosity_phasefield_init(fileUnit)
porosityState, &
porosityMapping, &
porosity, &
porosity_initialPhi, &
porosity_initialPhi
use config, only: &
material_partHomogenization, &
material_partPhase
use numerics,only: &
worldrank
implicit none
integer(pInt), intent(in) :: fileUnit
@ -94,11 +93,9 @@ subroutine porosity_phasefield_init(fileUnit)
tag = '', &
line = ''
mainProcess: if (worldrank == 0) then
write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(/,a)') ' <<<+- porosity_'//POROSITY_phasefield_label//' init -+>>>'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
maxNinstance = int(count(porosity_type == POROSITY_phasefield_ID),pInt)
if (maxNinstance == 0_pInt) return

2
src/prec.f90
View File

@ -68,7 +68,7 @@ module prec
nTrans = 0_pInt
logical :: &
nonlocal = .false.
real(pReal), pointer, dimension(:,:), contiguous :: &
real(pReal), pointer, dimension(:,:) :: &
slipRate, & !< slip rate
accumulatedSlip !< accumulated plastic slip
end type

5
src/source_damage_anisoBrittle.f90
View File

@ -91,9 +91,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit)
phase_Noutput, &
SOURCE_damage_anisoBrittle_label, &
SOURCE_damage_anisoBrittle_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

5
src/source_damage_anisoDuctile.f90
View File

@ -95,9 +95,10 @@ subroutine source_damage_anisoDuctile_init(fileUnit)
phase_Noutput, &
SOURCE_damage_anisoDuctile_label, &
SOURCE_damage_anisoDuctile_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

5
src/source_damage_isoBrittle.f90
View File

@ -81,9 +81,10 @@ subroutine source_damage_isoBrittle_init(fileUnit)
phase_Noutput, &
SOURCE_damage_isoBrittle_label, &
SOURCE_damage_isoBrittle_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

6
src/source_damage_isoDuctile.f90
View File

@ -81,10 +81,12 @@ subroutine source_damage_isoDuctile_init(fileUnit)
phase_Noutput, &
SOURCE_damage_isoDuctile_label, &
SOURCE_damage_isoDuctile_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

5
src/source_thermal_dissipation.f90
View File

@ -67,9 +67,10 @@ subroutine source_thermal_dissipation_init(fileUnit)
phase_Noutput, &
SOURCE_thermal_dissipation_label, &
SOURCE_thermal_dissipation_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

5
src/source_thermal_externalheat.f90
View File

@ -73,9 +73,10 @@ subroutine source_thermal_externalheat_init(fileUnit)
phase_Noutput, &
SOURCE_thermal_externalheat_label, &
SOURCE_thermal_externalheat_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

5
src/source_vacancy_irradiation.f90
View File

@ -69,9 +69,10 @@ subroutine source_vacancy_irradiation_init(fileUnit)
phase_Noutput, &
SOURCE_vacancy_irradiation_label, &
SOURCE_vacancy_irradiation_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

5
src/source_vacancy_phenoplasticity.f90
View File

@ -67,9 +67,10 @@ subroutine source_vacancy_phenoplasticity_init(fileUnit)
phase_Noutput, &
SOURCE_vacancy_phenoplasticity_label, &
SOURCE_vacancy_phenoplasticity_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

5
src/source_vacancy_thermalfluc.f90
View File

@ -71,9 +71,10 @@ subroutine source_vacancy_thermalfluc_init(fileUnit)
phase_Noutput, &
SOURCE_vacancy_thermalfluc_label, &
SOURCE_vacancy_thermalfluc_ID, &
material_Nphase, &
material_phase, &
sourceState, &
sourceState
use config, only: &
material_Nphase, &
MATERIAL_partPhase
use numerics,only: &
numerics_integrator

82
src/spectral_damage.f90
View File

@ -4,6 +4,10 @@
!> @brief Spectral solver for nonlocal damage
!--------------------------------------------------------------------------------------------------
module spectral_damage
#include <petsc/finclude/petscsnes.h>
#include <petsc/finclude/petscdmda.h>
use PETScdmda
use PETScsnes
use prec, only: &
pInt, &
pReal
@ -18,7 +22,6 @@ module spectral_damage
implicit none
private
#include <petsc/finclude/petsc.h90>
character (len=*), parameter, public :: &
spectral_damage_label = 'spectraldamage'
@ -46,13 +49,9 @@ module spectral_damage
public :: &
spectral_damage_init, &
spectral_damage_solution, &
spectral_damage_forward, &
spectral_damage_destroy
spectral_damage_forward
external :: &
PETScFinalize, &
MPI_Abort, &
MPI_Bcast, &
MPI_Allreduce
PETScErrorF ! is called in the CHKERRQ macro
contains
@ -79,32 +78,22 @@ subroutine spectral_damage_init()
damage_nonlocal_getMobility
implicit none
integer(pInt), dimension(:), allocatable :: localK
PetscInt, dimension(:), allocatable :: localK
integer(pInt) :: proc
integer(pInt) :: i, j, k, cell
DM :: damage_grid
Vec :: uBound, lBound
PetscErrorCode :: ierr
character(len=100) :: snes_type
external :: &
SNESCreate, &
SNESSetOptionsPrefix, &
DMDACreate3D, &
SNESSetDM, &
DMDAGetCorners, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
SNESSetFromOptions, &
SNESGetType, &
VecSet, &
DMGetGlobalVector, &
DMRestoreGlobalVector, &
SNESVISetVariableBounds
DMDAGetCorners, &
DMDASNESSetFunctionLocal
write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press, '
write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 '
write(6,'(a,/)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018 '
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
@ -116,21 +105,23 @@ subroutine spectral_damage_init()
do proc = 1, worldsize
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
enddo
call DMDACreate3d(PETSC_COMM_WORLD, &
call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & !< cut off stencil at boundary
DMDA_STENCIL_BOX, & !< Moore (26) neighborhood around central point
grid(1),grid(2),grid(3), & !< global grid
1, 1, worldsize, &
1, 0, & !< #dof (damage phase field), ghost boundary width (domain overlap)
grid(1),grid(2),localK, & !< local grid
[grid(1)],[grid(2)],localK, & !< local grid
damage_grid,ierr) !< handle, error
CHKERRQ(ierr)
call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da
call DMsetFromOptions(damage_grid,ierr); CHKERRQ(ierr)
call DMsetUp(damage_grid,ierr); CHKERRQ(ierr)
call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,&
PETSC_NULL_OBJECT,ierr) !< residual vector of same shape as solution vector
PETSC_NULL_SNES,ierr) !< residual vector of same shape as solution vector
CHKERRQ(ierr)
call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional cli arguments
call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional CLI arguments
call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr)
if (trim(snes_type) == 'vinewtonrsls' .or. &
trim(snes_type) == 'vinewtonssls') then
@ -138,7 +129,7 @@ subroutine spectral_damage_init()
call DMGetGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr)
call VecSet(lBound,0.0,ierr); CHKERRQ(ierr)
call VecSet(uBound,1.0,ierr); CHKERRQ(ierr)
call SNESVISetVariableBounds(damage_snes,lBound,uBound,ierr) !< variable bounds for variational inequalities like contact mechanics, damage etc.
call SNESVISetVariableBounds(damage_snes,lBound,uBound,ierr) !< variable bounds for variational inequalities like contact mechanics, damage etc.
call DMRestoreGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr)
call DMRestoreGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr)
endif
@ -206,8 +197,7 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC
external :: &
VecMin, &
VecMax, &
SNESSolve, &
SNESGetConvergedReason
SNESSolve
spectral_damage_solution%converged =.false.
@ -216,7 +206,7 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC
params%timeinc = timeinc
params%timeincOld = timeinc_old
call SNESSolve(damage_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr)
call SNESSolve(damage_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr)
call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr)
if (reason < 1) then
@ -244,14 +234,12 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC
call VecMin(solution,position,minDamage,ierr); CHKERRQ(ierr)
call VecMax(solution,position,maxDamage,ierr); CHKERRQ(ierr)
if (worldrank == 0) then
if (spectral_damage_solution%converged) &
write(6,'(/,a)') ' ... nonlocal damage converged .....................................'
write(6,'(/,a,f8.6,2x,f8.6,2x,f8.6,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',&
if (spectral_damage_solution%converged) &
write(6,'(/,a)') ' ... nonlocal damage converged .....................................'
write(6,'(/,a,f8.6,2x,f8.6,2x,f8.6,/)',advance='no') ' Minimum|Maximum|Delta Damage = ',&
minDamage, maxDamage, stagNorm
write(6,'(/,a)') ' ==========================================================================='
flush(6)
endif
write(6,'(/,a)') ' ==========================================================================='
flush(6)
end function spectral_damage_solution
@ -362,9 +350,6 @@ subroutine spectral_damage_forward()
PetscScalar, dimension(:,:,:), pointer :: x_scal
PetscErrorCode :: ierr
external :: &
SNESGetDM
if (cutBack) then
damage_current = damage_lastInc
damage_stagInc = damage_lastInc
@ -397,23 +382,6 @@ subroutine spectral_damage_forward()
call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
endif
end subroutine spectral_damage_forward
!--------------------------------------------------------------------------------------------------
!> @brief destroy routine
!--------------------------------------------------------------------------------------------------
subroutine spectral_damage_destroy()
implicit none
PetscErrorCode :: ierr
external :: &
VecDestroy, &
SNESDestroy
call VecDestroy(solution,ierr); CHKERRQ(ierr)
call SNESDestroy(damage_snes,ierr); CHKERRQ(ierr)
end subroutine spectral_damage_destroy
end subroutine spectral_damage_forward
end module spectral_damage

24
src/spectral_interface.f90
View File

@ -11,9 +11,9 @@
module DAMASK_interface
use prec, only: &
pInt
implicit none
private
#include <petsc/finclude/petscsys.h>
logical, public, protected :: appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding)
integer(pInt), public, protected :: spectralRestartInc = 0_pInt !< Increment at which calculation starts
character(len=1024), public, protected :: &
@ -44,7 +44,13 @@ contains
subroutine DAMASK_interface_init()
use, intrinsic :: &
iso_fortran_env
#include <petsc/finclude/petscsys.h>
#if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR!=9
===================================================================================================
========================= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =========================
===================================================================================================
#endif
use PETScSys
use system_routines, only: &
getHostName
@ -72,11 +78,8 @@ subroutine DAMASK_interface_init()
logical :: error
external :: &
quit,&
MPI_Comm_rank,&
MPI_Comm_size,&
PETScInitialize, &
MPI_Init_Thread, &
MPI_abort
PETScErrorF, & ! is called in the CHKERRQ macro
PETScInitialize
open(6, encoding='UTF-8') ! for special characters in output
@ -91,7 +94,7 @@ subroutine DAMASK_interface_init()
call quit(1_pInt)
endif
#endif
call PetscInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code
call PETScInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code
CHKERRQ(ierr) ! this is a macro definition, it is case sensitive
call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr)
call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr)
@ -104,10 +107,6 @@ subroutine DAMASK_interface_init()
write(output_unit,'(a)') ' STDERR != 0'
call quit(1_pInt)
endif
if (PETSC_VERSION_MAJOR /= 3 .or. PETSC_VERSION_MINOR /= 7) then
write(6,'(a,2(i1.1,a))') 'PETSc ',PETSC_VERSION_MAJOR,'.',PETSC_VERSION_MINOR,'.x not supported'
call quit(1_pInt)
endif
else mainProcess
close(6) ! disable output for non-master processes (open 6 to rank specific file for debug)
open(6,file='/dev/null',status='replace') ! close(6) alone will leave some temp files in cwd
@ -525,5 +524,4 @@ pure function IIO_stringPos(string)
end function IIO_stringPos
end module

106
src/spectral_mech_Basic.f90
View File

@ -2,9 +2,13 @@
!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
!> @brief Basic scheme PETSc solver
!> @brief Basic scheme solver
!--------------------------------------------------------------------------------------------------
module spectral_mech_basic
#include <petsc/finclude/petscsnes.h>
#include <petsc/finclude/petscdmda.h>
use PETScdmda
use PETScsnes
use prec, only: &
pInt, &
pReal
@ -16,10 +20,9 @@ module spectral_mech_basic
implicit none
private
#include <petsc/finclude/petsc.h90>
character (len=*), parameter, public :: &
DAMASK_spectral_SolverBasicPETSC_label = 'basicpetsc'
DAMASK_spectral_SolverBasic_label = 'basic'
!--------------------------------------------------------------------------------------------------
! derived types
@ -62,22 +65,18 @@ module spectral_mech_basic
real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal
public :: &
basicPETSc_init, &
basicPETSc_solution, &
BasicPETSc_forward, &
basicPETSc_destroy
basic_init, &
basic_solution, &
basic_forward
external :: &
PETScFinalize, &
MPI_Abort, &
MPI_Bcast, &
MPI_Allreduce
PETScErrorF ! is called in the CHKERRQ macro
contains
!--------------------------------------------------------------------------------------------------
!> @brief allocates all necessary fields and fills them with data, potentially from restart info
!--------------------------------------------------------------------------------------------------
subroutine basicPETSc_init
subroutine basic_init
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
use, intrinsic :: iso_fortran_env, only: &
compiler_version, &
@ -118,25 +117,18 @@ subroutine basicPETSc_init
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: F
integer(pInt), dimension(:), allocatable :: localK
PetscInt, dimension(:), allocatable :: localK
integer(pInt) :: proc
character(len=1024) :: rankStr
external :: &
SNESCreate, &
SNESSetOptionsPrefix, &
DMDACreate3D, &
SNESSetDM, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions
DMDASNESSetFunctionLocal
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>'
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasic init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015'
write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
@ -159,16 +151,18 @@ subroutine basicPETSc_init
grid(1),grid(2),grid(3), & ! global grid
1 , 1, worldsize, &
9, 0, & ! #dof (F tensor), ghost boundary width (domain overlap)
grid(1),grid(2),localK, & ! local grid
[grid(1)],[grid(2)],localK, & ! local grid
da,ierr) ! handle, error
CHKERRQ(ierr)
call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector
call DMsetFromOptions(da,ierr); CHKERRQ(ierr)
call DMsetUp(da,ierr); CHKERRQ(ierr)
call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor)
call DMDASNESsetFunctionLocal(da,INSERT_VALUES,Basic_formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector
CHKERRQ(ierr)
call SNESSetConvergenceTest(snes,BasicPETSC_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged"
call SNESsetConvergenceTest(snes,Basic_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged"
CHKERRQ(ierr)
call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments
call SNESsetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments
!--------------------------------------------------------------------------------------------------
! init fields
@ -218,12 +212,12 @@ subroutine basicPETSc_init
call Utilities_updateGamma(C_minMaxAvg,.true.)
end subroutine basicPETSc_init
end subroutine basic_init
!--------------------------------------------------------------------------------------------------
!> @brief solution for the Basic PETSC scheme with internal iterations
!> @brief solution for the Basic scheme with internal iterations
!--------------------------------------------------------------------------------------------------
type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC)
type(tSolutionState) function basic_solution(incInfoIn,timeinc,timeinc_old,stress_BC,rotation_BC)
use IO, only: &
IO_error
use numerics, only: &
@ -255,8 +249,7 @@ type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old,
SNESConvergedReason :: reason
external :: &
SNESSolve, &
SNESGetConvergedReason
SNESsolve
incInfo = incInfoIn
@ -276,25 +269,25 @@ type(tSolutionState) function basicPETSc_solution(incInfoIn,timeinc,timeinc_old,
!--------------------------------------------------------------------------------------------------
! solve BVP
call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr); CHKERRQ(ierr)
call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! check convergence
call SNESGetConvergedReason(snes,reason,ierr); CHKERRQ(ierr)
BasicPETSc_solution%converged = reason > 0
basicPETSC_solution%iterationsNeeded = totalIter
basicPETSc_solution%termIll = terminallyIll
basic_solution%converged = reason > 0
basic_solution%iterationsNeeded = totalIter
basic_solution%termIll = terminallyIll
terminallyIll = .false.
if (reason == -4) call IO_error(893_pInt) ! MPI error
end function BasicPETSc_solution
end function basic_solution
!--------------------------------------------------------------------------------------------------
!> @brief forms the basic residual vector
!--------------------------------------------------------------------------------------------------
subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
subroutine Basic_formResidual(in,x_scal,f_scal,dummy,ierr)
use numerics, only: &
itmax, &
itmin
@ -334,10 +327,6 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
real(pReal), dimension(3,3) :: &
deltaF_aim
external :: &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber
call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr)
call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr)
@ -381,13 +370,13 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr)
! constructing residual
f_scal = tensorField_real(1:3,1:3,1:grid(1),1:grid(2),1:grid3) ! Gamma*P gives correction towards div(P) = 0, so needs to be zero, too
end subroutine BasicPETSc_formResidual
end subroutine Basic_formResidual
!--------------------------------------------------------------------------------------------------
!> @brief convergence check
!--------------------------------------------------------------------------------------------------
subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr)
subroutine Basic_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr)
use numerics, only: &
itmax, &
itmin, &
@ -436,14 +425,14 @@ subroutine BasicPETSc_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,du
write(6,'(/,a)') ' ==========================================================================='
flush(6)
end subroutine BasicPETSc_converged
end subroutine Basic_converged
!--------------------------------------------------------------------------------------------------
!> @brief forwarding routine
!> @details find new boundary conditions and best F estimate for end of current timestep
!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
!--------------------------------------------------------------------------------------------------
subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
subroutine Basic_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation_BC,stress_BC,rotation_BC)
use math, only: &
math_mul33x33 ,&
math_rotate_backward33
@ -549,27 +538,6 @@ subroutine BasicPETSc_forward(guess,timeinc,timeinc_old,loadCaseTime,deformation
math_rotate_backward33(F_aim,rotation_BC)),[9,grid(1),grid(2),grid3])
call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
end subroutine BasicPETSc_forward
!--------------------------------------------------------------------------------------------------
!> @brief destroy routine
!--------------------------------------------------------------------------------------------------
subroutine BasicPETSc_destroy()
use spectral_utilities, only: &
Utilities_destroy
implicit none
PetscErrorCode :: ierr
external :: &
VecDestroy, &
SNESDestroy, &
DMDestroy
call VecDestroy(solution_vec,ierr); CHKERRQ(ierr)
call SNESDestroy(snes,ierr); CHKERRQ(ierr)
call DMDestroy(da,ierr); CHKERRQ(ierr)
end subroutine BasicPETSc_destroy
end subroutine Basic_forward
end module spectral_mech_basic

74
src/spectral_mech_Polarisation.f90
View File

@ -5,6 +5,10 @@
!> @brief Polarisation scheme solver
!--------------------------------------------------------------------------------------------------
module spectral_mech_Polarisation
#include <petsc/finclude/petscsnes.h>
#include <petsc/finclude/petscdmda.h>
use PETScdmda
use PETScsnes
use prec, only: &
pInt, &
pReal
@ -16,7 +20,6 @@ module spectral_mech_Polarisation
implicit none
private
#include <petsc/finclude/petsc.h90>
character (len=*), parameter, public :: &
DAMASK_spectral_solverPolarisation_label = 'polarisation'
@ -70,13 +73,9 @@ module spectral_mech_Polarisation
public :: &
Polarisation_init, &
Polarisation_solution, &
Polarisation_forward, &
Polarisation_destroy
Polarisation_forward
external :: &
PETScFinalize, &
MPI_Abort, &
MPI_Bcast, &
MPI_Allreduce
PETScErrorF ! is called in the CHKERRQ macro
contains
@ -125,28 +124,21 @@ subroutine Polarisation_init
PetscErrorCode :: ierr
PetscScalar, pointer, dimension(:,:,:,:) :: &
FandF_tau, & ! overall pointer to solution data
F, & ! specific (sub)pointer
F_tau ! specific (sub)pointer
integer(pInt), dimension(:), allocatable :: localK
FandF_tau, & ! overall pointer to solution data
F, & ! specific (sub)pointer
F_tau ! specific (sub)pointer
PetscInt, dimension(:), allocatable :: localK
integer(pInt) :: proc
character(len=1024) :: rankStr
external :: &
SNESCreate, &
SNESSetOptionsPrefix, &
DMDACreate3D, &
SNESSetDM, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
SNESGetConvergedReason, &
SNESSetConvergenceTest, &
SNESSetFromOptions
DMDASNESsetFunctionLocal
write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., International Journal of Plasticity, 66:31–45, 2015'
write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2014.02.006'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
@ -171,16 +163,18 @@ subroutine Polarisation_init
grid(1),grid(2),grid(3), & ! global grid
1 , 1, worldsize, &
18, 0, & ! #dof (F tensor), ghost boundary width (domain overlap)
grid(1),grid(2),localK, & ! local grid
[grid(1)],[grid(2)],localK, & ! local grid
da,ierr) ! handle, error
CHKERRQ(ierr)
call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da
call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector
call DMsetFromOptions(da,ierr); CHKERRQ(ierr)
call DMsetUp(da,ierr); CHKERRQ(ierr)
call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 18, i.e. every def grad tensor)
call DMDASNESsetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector
CHKERRQ(ierr)
call SNESSetConvergenceTest(snes,Polarisation_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged"
call SNESsetConvergenceTest(snes,Polarisation_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged"
CHKERRQ(ierr)
call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments
call SNESsetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments
!--------------------------------------------------------------------------------------------------
! init fields
@ -280,8 +274,7 @@ type(tSolutionState) function Polarisation_solution(incInfoIn,timeinc,timeinc_ol
SNESConvergedReason :: reason
external :: &
SNESSolve, &
SNESGetConvergedReason
SNESSolve
incInfo = incInfoIn
@ -304,7 +297,7 @@ type(tSolutionState) function Polarisation_solution(incInfoIn,timeinc,timeinc_ol
!--------------------------------------------------------------------------------------------------
! solve BVP
call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr); CHKERRQ(ierr)
call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr)
!--------------------------------------------------------------------------------------------------
! check convergence
@ -375,10 +368,6 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr)
integer(pInt) :: &
i, j, k, e
external :: &
SNESGetNumberFunctionEvals, &
SNESGetIterationNumber
F => x_scal(1:3,1:3,1,&
XG_RANGE,YG_RANGE,ZG_RANGE)
F_tau => x_scal(1:3,1:3,2,&
@ -685,25 +674,4 @@ subroutine Polarisation_forward(guess,timeinc,timeinc_old,loadCaseTime,deformati
end subroutine Polarisation_forward
!--------------------------------------------------------------------------------------------------
!> @brief destroy routine
!--------------------------------------------------------------------------------------------------
subroutine Polarisation_destroy()
use spectral_utilities, only: &
Utilities_destroy
implicit none
PetscErrorCode :: ierr
external :: &
VecDestroy, &
SNESDestroy, &
DMDestroy
call VecDestroy(solution_vec,ierr); CHKERRQ(ierr)
call SNESDestroy(snes,ierr); CHKERRQ(ierr)
call DMDestroy(da,ierr); CHKERRQ(ierr)
end subroutine Polarisation_destroy
end module spectral_mech_Polarisation

87
src/spectral_thermal.f90
View File

@ -4,6 +4,10 @@
!> @brief Spectral solver for thermal conduction
!--------------------------------------------------------------------------------------------------
module spectral_thermal
#include <petsc/finclude/petscsnes.h>
#include <petsc/finclude/petscdmda.h>
use PETScdmda
use PETScsnes
use prec, only: &
pInt, &
pReal
@ -18,7 +22,6 @@ module spectral_thermal
implicit none
private
#include <petsc/finclude/petsc.h90>
character (len=*), parameter, public :: &
spectral_thermal_label = 'spectralthermal'
@ -46,13 +49,9 @@ module spectral_thermal
public :: &
spectral_thermal_init, &
spectral_thermal_solution, &
spectral_thermal_forward, &
spectral_thermal_destroy
spectral_thermal_forward
external :: &
PETScFinalize, &
MPI_Abort, &
MPI_Bcast, &
MPI_Allreduce
PETScErrorF ! is called in the CHKERRQ macro
contains
@ -92,22 +91,15 @@ subroutine spectral_thermal_init
PetscErrorCode :: ierr
external :: &
SNESCreate, &
SNESSetOptionsPrefix, &
DMDACreate3D, &
SNESSetDM, &
DMDAGetCorners, &
DMCreateGlobalVector, &
DMDASNESSetFunctionLocal, &
SNESSetFromOptions
SNESsetOptionsPrefix, &
DMDAgetCorners, &
DMDASNESsetFunctionLocal
mainProcess: if (worldrank == 0_pInt) then
write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press,'
write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>'
write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press,'
write(6,'(/,a)') ' chapter Spectral Solvers for Crystal Plasticity and Multi-Physics Simulations. Springer, 2018'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
endif mainProcess
!--------------------------------------------------------------------------------------------------
! initialize solver specific parts of PETSc
@ -117,21 +109,23 @@ subroutine spectral_thermal_init
do proc = 1, worldsize
call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr)
enddo
call DMDACreate3d(PETSC_COMM_WORLD, &
call DMDACreate3D(PETSC_COMM_WORLD, &
DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & ! cut off stencil at boundary
DMDA_STENCIL_BOX, & ! Moore (26) neighborhood around central point
grid(1),grid(2),grid(3), & ! global grid
1, 1, worldsize, &
1, 0, & ! #dof (temperature field), ghost boundary width (domain overlap)
grid (1),grid(2),localK, & ! local grid
thermal_grid,ierr) ! handle, error
1, 0, & !< #dof (thermal phase field), ghost boundary width (domain overlap)
[grid(1)],[grid(2)],localK, & !< local grid
thermal_grid,ierr) !< handle, error
CHKERRQ(ierr)
call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da
call DMsetFromOptions(thermal_grid,ierr); CHKERRQ(ierr)
call DMsetUp(thermal_grid,ierr); CHKERRQ(ierr)
call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor)
call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,&
PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector
PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector
CHKERRQ(ierr)
call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments
call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional CLI arguments
!--------------------------------------------------------------------------------------------------
! init fields
@ -207,8 +201,7 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load
external :: &
VecMin, &
VecMax, &
SNESSolve, &
SNESGetConvergedReason
SNESSolve
spectral_thermal_solution%converged =.false.
@ -217,7 +210,7 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load
params%timeinc = timeinc
params%timeincOld = timeinc_old
call SNESSolve(thermal_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr)
call SNESSolve(thermal_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr)
call SNESGetConvergedReason(thermal_snes,reason,ierr); CHKERRQ(ierr)
if (reason < 1) then
@ -247,14 +240,12 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load
call VecMin(solution,position,minTemperature,ierr); CHKERRQ(ierr)
call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr)
if (worldrank == 0) then
if (spectral_thermal_solution%converged) &
write(6,'(/,a)') ' ... thermal conduction converged ..................................'
write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',&
if (spectral_thermal_solution%converged) &
write(6,'(/,a)') ' ... thermal conduction converged ..................................'
write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',&
minTemperature, maxTemperature, stagNorm
write(6,'(/,a)') ' ==========================================================================='
flush(6)
endif
write(6,'(/,a)') ' ==========================================================================='
flush(6)
end function spectral_thermal_solution
@ -361,9 +352,6 @@ subroutine spectral_thermal_forward()
PetscScalar, dimension(:,:,:), pointer :: x_scal
PetscErrorCode :: ierr
external :: &
SNESGetDM
if (cutBack) then
temperature_current = temperature_lastInc
temperature_stagInc = temperature_lastInc
@ -401,23 +389,6 @@ subroutine spectral_thermal_forward()
call MPI_Allreduce(MPI_IN_PLACE,mobility_ref,1,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
endif
end subroutine spectral_thermal_forward
!--------------------------------------------------------------------------------------------------
!> @brief destroy routine
!--------------------------------------------------------------------------------------------------
subroutine spectral_thermal_destroy()
implicit none
PetscErrorCode :: ierr
external :: &
VecDestroy, &
SNESDestroy
call VecDestroy(solution,ierr); CHKERRQ(ierr)
call SNESDestroy(thermal_snes,ierr); CHKERRQ(ierr)
end subroutine spectral_thermal_destroy
end subroutine spectral_thermal_forward
end module spectral_thermal

55
src/spectral_utilities.f90
View File

@ -5,6 +5,8 @@
!--------------------------------------------------------------------------------------------------
module spectral_utilities
use, intrinsic :: iso_c_binding
#include <petsc/finclude/petscsys.h>
use PETScSys
use prec, only: &
pReal, &
pInt
@ -13,7 +15,6 @@ module spectral_utilities
implicit none
private
#include <petsc/finclude/petscsys.h>
include 'fftw3-mpi.f03'
logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill
@ -139,7 +140,6 @@ module spectral_utilities
utilities_constitutiveResponse, &
utilities_calculateRate, &
utilities_forwardField, &
utilities_destroy, &
utilities_updateIPcoords, &
FIELD_UNDEFINED_ID, &
FIELD_MECH_ID, &
@ -147,6 +147,8 @@ module spectral_utilities
FIELD_DAMAGE_ID
private :: &
utilities_getFreqDerivative
external :: &
PETScErrorF ! is called in the CHKERRQ macro
contains
@ -195,12 +197,6 @@ subroutine utilities_init()
geomSize
implicit none
external :: &
PETScOptionsClear, &
PETScOptionsInsertString, &
MPI_Abort
PetscErrorCode :: ierr
integer(pInt) :: i, j, k
integer(pInt), dimension(3) :: k_s
@ -214,10 +210,12 @@ subroutine utilities_init()
scalarSize = 1_C_INTPTR_T, &
vecSize = 3_C_INTPTR_T, &
tensorSize = 9_C_INTPTR_T
external :: &
PetscOptionsInsertString
write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>'
write(6,'(/,a)') ' Eisenlohr et al., International Journal of Plasticity, 46:37–53, 2013'
write(6,'(/,a)') ' https://doi.org/10.1016/j.ijplas.2012.09.012'
write(6,'(a,/)') ' https://doi.org/10.1016/j.ijplas.2012.09.012'
write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
#include "compilation_info.f90"
@ -232,13 +230,13 @@ subroutine utilities_init()
trim(PETScDebug), &
' add more using the PETSc_Options keyword in numerics.config '; flush(6)
call PetscOptionsClear(PETSC_NULL_OBJECT,ierr)
call PETScOptionsClear(PETSC_NULL_OPTIONS,ierr)
CHKERRQ(ierr)
if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(PETSCDEBUG),ierr)
if(debugPETSc) call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
CHKERRQ(ierr)
call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_defaultOptions),ierr)
call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr)
CHKERRQ(ierr)
call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_options),ierr)
call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr)
CHKERRQ(ierr)
grid1Red = grid(1)/2_pInt + 1_pInt
@ -632,9 +630,6 @@ real(pReal) function utilities_divergenceRMS()
integer(pInt) :: i, j, k, ierr
complex(pReal), dimension(3) :: rescaledGeom
external :: &
MPI_Allreduce
write(6,'(/,a)') ' ... calculating divergence ................................................'
flush(6)
@ -686,9 +681,6 @@ real(pReal) function utilities_curlRMS()
complex(pReal), dimension(3,3) :: curl_fourier
complex(pReal), dimension(3) :: rescaledGeom
external :: &
MPI_Allreduce
write(6,'(/,a)') ' ... calculating curl ......................................................'
flush(6)
@ -962,9 +954,6 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
real(pReal), dimension(3,3,3,3) :: max_dPdF, min_dPdF
real(pReal) :: max_dPdF_norm, min_dPdF_norm, defgradDetMin, defgradDetMax, defgradDet
external :: &
MPI_Allreduce
write(6,'(/,a)') ' ... evaluating constitutive response ......................................'
flush(6)
@ -1081,9 +1070,6 @@ function utilities_forwardField(timeinc,field_lastInc,rate,aim)
real(pReal), dimension(3,3) :: fieldDiff !< <a + adot*t> - aim
PetscErrorCode :: ierr
external :: &
MPI_Allreduce
utilities_forwardField = field_lastInc + rate*timeinc
if (present(aim)) then !< correct to match average
fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt
@ -1175,8 +1161,6 @@ subroutine utilities_updateIPcoords(F)
integer(pInt) :: i, j, k, m, ierr
real(pReal), dimension(3) :: step, offset_coords
real(pReal), dimension(3,3) :: Favg
external &
MPI_Bcast
!--------------------------------------------------------------------------------------------------
! integration in Fourier space
@ -1215,21 +1199,4 @@ subroutine utilities_updateIPcoords(F)
end subroutine utilities_updateIPcoords
!--------------------------------------------------------------------------------------------------
!> @brief cleans up
!--------------------------------------------------------------------------------------------------
subroutine utilities_destroy()
implicit none
call fftw_destroy_plan(planTensorForth)
call fftw_destroy_plan(planTensorBack)
call fftw_destroy_plan(planVectorForth)
call fftw_destroy_plan(planVectorBack)
call fftw_destroy_plan(planScalarForth)
call fftw_destroy_plan(planScalarBack)
end subroutine utilities_destroy
end module spectral_utilities

35
src/system_routines.f90
View File

@ -10,11 +10,12 @@ module system_routines
public :: &
isDirectory, &
getCWD, &
getHostName
getHostName, &
setCWD
interface
function isDirectory_C(path) BIND(C)
function isDirectory_C(path) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
@ -38,6 +39,14 @@ interface
integer(C_INT),intent(out) :: stat
end subroutine getHostName_C
function chdir_C(path) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
integer(C_INT) :: chdir_C
character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array
end function chdir_C
end interface
@ -123,5 +132,27 @@ logical function getHostName(str)
end function getHostName
!--------------------------------------------------------------------------------------------------
!> @brief changes the current working directory
!--------------------------------------------------------------------------------------------------
logical function setCWD(path)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
integer :: i
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
end function setCWD
end module system_routines

5
src/thermal_adiabatic.f90
View File

@ -64,6 +64,8 @@ subroutine thermal_adiabatic_init(fileUnit)
IO_error, &
IO_timeStamp, &
IO_EOF
use config, only: &
material_partHomogenization
use material, only: &
thermal_type, &
thermal_typeInstance, &
@ -76,8 +78,7 @@ subroutine thermal_adiabatic_init(fileUnit)
thermalMapping, &
thermal_initialT, &
temperature, &
temperatureRate, &
material_partHomogenization
temperatureRate
implicit none
integer(pInt), intent(in) :: fileUnit

3
src/thermal_conduction.f90
View File

@ -77,7 +77,8 @@ subroutine thermal_conduction_init(fileUnit)
thermalMapping, &
thermal_initialT, &
temperature, &
temperatureRate, &
temperatureRate
use config, only: &
material_partHomogenization
implicit none

1
src/thermal_isothermal.f90
View File

@ -27,6 +27,7 @@ subroutine thermal_isothermal_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &

7
src/vacancyflux_cahnhilliard.f90
View File

@ -91,9 +91,10 @@ subroutine vacancyflux_cahnhilliard_init(fileUnit)
vacancyfluxMapping, &
vacancyConc, &
vacancyConcRate, &
vacancyflux_initialCv, &
material_partHomogenization, &
material_partPhase
vacancyflux_initialCv
use config, only: &
material_partPhase, &
material_partHomogenization
implicit none
integer(pInt), intent(in) :: fileUnit

3
src/vacancyflux_isochempot.f90
View File

@ -74,7 +74,8 @@ subroutine vacancyflux_isochempot_init(fileUnit)
vacancyfluxMapping, &
vacancyConc, &
vacancyConcRate, &
vacancyflux_initialCv, &
vacancyflux_initialCv
use config, only: &
material_partHomogenization
implicit none

1
src/vacancyflux_isoconc.f90
View File

@ -27,6 +27,7 @@ subroutine vacancyflux_isoconc_init()
use IO, only: &
IO_timeStamp
use material
use config
implicit none
integer(pInt) :: &