diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index df8991900..829020e0f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -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 diff --git a/CMakeLists.txt b/CMakeLists.txt index f5d6546a9..ee376ef02 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -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 () diff --git a/CONFIG b/CONFIG index db75fa811..459216375 100644 --- a/CONFIG +++ b/CONFIG @@ -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 diff --git a/DAMASK_env.csh b/DAMASK_env.csh deleted file mode 120000 index e8a0a2c05..000000000 --- a/DAMASK_env.csh +++ /dev/null @@ -1 +0,0 @@ -env/DAMASK.csh \ No newline at end of file diff --git a/DAMASK_env.sh b/DAMASK_env.sh deleted file mode 120000 index 264b07d52..000000000 --- a/DAMASK_env.sh +++ /dev/null @@ -1 +0,0 @@ -env/DAMASK.sh \ No newline at end of file diff --git a/DAMASK_env.zsh b/DAMASK_env.zsh deleted file mode 120000 index cf3a247ef..000000000 --- a/DAMASK_env.zsh +++ /dev/null @@ -1 +0,0 @@ -env/DAMASK.zsh \ No newline at end of file diff --git a/DAMASK_prerequisites.sh b/DAMASK_prerequisites.sh index 3f5e25a71..4877d4b22 100755 --- a/DAMASK_prerequisites.sh +++ b/DAMASK_prerequisites.sh @@ -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 } diff --git a/Makefile b/Makefile index 0ba67963e..4149078d1 100644 --- a/Makefile +++ b/Makefile @@ -25,7 +25,6 @@ build/FEM: .PHONY: marc marc: - @./installation/symLink_Code.sh @./installation/mods_MarcMentat/apply_DAMASK_modifications.sh ${MAKEFLAGS} .PHONY: clean diff --git a/PRIVATE b/PRIVATE index b7d1d3091..aead92902 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit b7d1d309146e017caa5744333c2e4a4532a6fc20 +Subproject commit aead92902b3a0cf3404be9c552bfec918d7aaffb diff --git a/VERSION b/VERSION index 6e37920c9..6c338b298 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.1-1144-g5f28fa0 +v2.0.2-48-gaebb06e diff --git a/env/DAMASK.sh b/env/DAMASK.sh index 021603b57..509f5f1b7 100644 --- a/env/DAMASK.sh +++ b/env/DAMASK.sh @@ -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; }" diff --git a/env/DAMASK.zsh b/env/DAMASK.zsh index 2d2bc9aa0..3ceeb116a 100644 --- a/env/DAMASK.zsh +++ b/env/DAMASK.zsh @@ -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" \ diff --git a/examples/SpectralMethod/Polycrystal/material.config b/examples/SpectralMethod/Polycrystal/material.config index 978e0f511..5073f165e 100644 --- a/examples/SpectralMethod/Polycrystal/material.config +++ b/examples/SpectralMethod/Polycrystal/material.config @@ -3,7 +3,7 @@ #-------------------# [SX] -type none +mech none #-------------------# diff --git a/installation/mods_Abaqus/abaqus_v6.env b/installation/mods_Abaqus/abaqus_v6.env index 8d040cb23..b4710e198 100644 --- a/installation/mods_Abaqus/abaqus_v6.env +++ b/installation/mods_Abaqus/abaqus_v6.env @@ -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) diff --git a/installation/mods_Abaqus/abaqus_v6_serial.env b/installation/mods_Abaqus/abaqus_v6_serial.env index 8e4d8e367..c608b6993 100644 --- a/installation/mods_Abaqus/abaqus_v6_serial.env +++ b/installation/mods_Abaqus/abaqus_v6_serial.env @@ -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) diff --git a/installation/mods_MarcMentat/2014.2/Marc_tools/include_linux64 b/installation/mods_MarcMentat/2014.2/Marc_tools/include_linux64 index ba9258f1e..5ea0df864 100644 --- a/installation/mods_MarcMentat/2014.2/Marc_tools/include_linux64 +++ b/installation/mods_MarcMentat/2014.2/Marc_tools/include_linux64 @@ -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" diff --git a/installation/mods_MarcMentat/2014/Marc_tools/include_linux64 b/installation/mods_MarcMentat/2014/Marc_tools/include_linux64 index b7e6bb140..e67f8158e 100644 --- a/installation/mods_MarcMentat/2014/Marc_tools/include_linux64 +++ b/installation/mods_MarcMentat/2014/Marc_tools/include_linux64 @@ -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" diff --git a/installation/mods_MarcMentat/2015/Marc_tools/include_linux64 b/installation/mods_MarcMentat/2015/Marc_tools/include_linux64 index 0a315f85b..2f1abe6ba 100644 --- a/installation/mods_MarcMentat/2015/Marc_tools/include_linux64 +++ b/installation/mods_MarcMentat/2015/Marc_tools/include_linux64 @@ -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" diff --git a/installation/mods_MarcMentat/2016/Marc_tools/include_linux64 b/installation/mods_MarcMentat/2016/Marc_tools/include_linux64 index a6cc7e2f9..767226bac 100644 --- a/installation/mods_MarcMentat/2016/Marc_tools/include_linux64 +++ b/installation/mods_MarcMentat/2016/Marc_tools/include_linux64 @@ -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" diff --git a/installation/mods_MarcMentat/2017/Marc_tools/include_linux64 b/installation/mods_MarcMentat/2017/Marc_tools/include_linux64 index e42191a14..d2ab3f77f 100644 --- a/installation/mods_MarcMentat/2017/Marc_tools/include_linux64 +++ b/installation/mods_MarcMentat/2017/Marc_tools/include_linux64 @@ -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" diff --git a/installation/mods_MarcMentat/installation.txt b/installation/mods_MarcMentat/installation.txt index d463387af..ae1bca772 100644 --- a/installation/mods_MarcMentat/installation.txt +++ b/installation/mods_MarcMentat/installation.txt @@ -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 diff --git a/lib/damask/solver/marc.py b/lib/damask/solver/marc.py index 16f3c8451..59feb3325 100644 --- a/lib/damask/solver/marc.py +++ b/lib/damask/solver/marc.py @@ -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',''], } diff --git a/processing/post/addAPS34IDEstrainCoords.py b/processing/post/addAPS34IDEstrainCoords.py index 8a793a8cf..2e753bfa4 100755 --- a/processing/post/addAPS34IDEstrainCoords.py +++ b/processing/post/addAPS34IDEstrainCoords.py @@ -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) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9789ec67d..9418cd56d 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -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 $) add_library(PREC OBJECT "prec.f90") -add_dependencies(PREC SYSTEM_ROUTINES) list(APPEND OBJECTFILES $) -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 $) add_library(IO OBJECT "IO.f90") @@ -38,6 +39,10 @@ add_library(DEBUG OBJECT "debug.f90") add_dependencies(DEBUG NUMERICS) list(APPEND OBJECTFILES $) +add_library(CONFIG OBJECT "config.f90") +add_dependencies(CONFIG DEBUG) +list(APPEND OBJECTFILES $) + add_library(FEsolving OBJECT "FEsolving.f90") add_dependencies(FEsolving DEBUG) list(APPEND OBJECTFILES $) @@ -47,11 +52,11 @@ add_dependencies(DAMASK_MATH FEsolving) list(APPEND OBJECTFILES $) # 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 $) -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 $) @@ -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 $) 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 $) -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 $) @@ -170,13 +175,13 @@ if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral") "spectral_mech_Basic.f90") add_dependencies(SPECTRAL_SOLVER SPECTRAL_UTILITIES) list(APPEND OBJECTFILES $) - 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) diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index 66aa11433..6caeaf57c 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -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,& diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index a89bfc294..c66aa4089 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -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,& diff --git a/src/C_routines.c b/src/C_routines.c index 5bc09745f..e3891765a 100644 --- a/src/C_routines.c +++ b/src/C_routines.c @@ -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); +} diff --git a/src/DAMASK_marc2014.2.f90 b/src/DAMASK_marc2014.2.f90 deleted file mode 120000 index 2c5bec706..000000000 --- a/src/DAMASK_marc2014.2.f90 +++ /dev/null @@ -1 +0,0 @@ -DAMASK_marc.f90 \ No newline at end of file diff --git a/src/DAMASK_marc2014.f90 b/src/DAMASK_marc2014.f90 deleted file mode 120000 index 2c5bec706..000000000 --- a/src/DAMASK_marc2014.f90 +++ /dev/null @@ -1 +0,0 @@ -DAMASK_marc.f90 \ No newline at end of file diff --git a/src/DAMASK_marc2015.f90 b/src/DAMASK_marc2015.f90 deleted file mode 120000 index 2c5bec706..000000000 --- a/src/DAMASK_marc2015.f90 +++ /dev/null @@ -1 +0,0 @@ -DAMASK_marc.f90 \ No newline at end of file diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index c5bf70397..0d77c57f5 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -12,6 +12,8 @@ program DAMASK_spectral compiler_version, & compiler_options #endif +#include + 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 - !-------------------------------------------------------------------------------------------------- ! 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 + 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 + implicit none 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' diff --git a/src/IO.f90 b/src/IO.f90 index 7291f36ad..a7e77f0f4 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -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) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index f57f03467..0d4b55255 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -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" diff --git a/src/config.f90 b/src/config.f90 new file mode 100644 index 000000000..9d2ddde4c --- /dev/null +++ b/src/config.f90 @@ -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 diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 7f1bff89e..755cb87d2 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -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 diff --git a/src/crystallite.f90 b/src/crystallite.f90 index dd497ad17..dc8751978 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -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 - 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) @@ -382,14 +357,14 @@ subroutine crystallite_init crystallite_maxSizePostResults = & maxval(crystallite_sizePostResults(microstructure_crystallite),microstructure_active) - + !-------------------------------------------------------------------------------------------------- ! write description file for crystallite output 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) = & diff --git a/src/damage_local.f90 b/src/damage_local.f90 index 59956e7d1..74bcb00db 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -70,7 +70,8 @@ subroutine damage_local_init(fileUnit) damageState, & damageMapping, & damage, & - damage_initialPhi, & + damage_initialPhi + use config, only: & material_partHomogenization implicit none diff --git a/src/damage_none.f90 b/src/damage_none.f90 index a1f0f0cd5..90b1acc72 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -26,6 +26,7 @@ subroutine damage_none_init() use IO, only: & IO_timeStamp use material + use config implicit none integer(pInt) :: & diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index 92ad183e1..6b9093ef1 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -75,7 +75,8 @@ subroutine damage_nonlocal_init(fileUnit) damageState, & damageMapping, & damage, & - damage_initialPhi, & + damage_initialPhi + use config, only: & material_partHomogenization implicit none diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 6db264989..23c2ccad5 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -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 diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index fe9885215..92ea5301d 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -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') diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index b569e3737..8ee0df73d 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -62,6 +62,7 @@ subroutine homogenization_isostrain_init(fileUnit) debug_levelBasic use IO use material + use config implicit none integer(pInt), intent(in) :: fileUnit diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index b2d2f52a7..c33aabe89 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -29,6 +29,7 @@ subroutine homogenization_none_init() use IO, only: & IO_timeStamp use material + use config implicit none integer(pInt) :: & diff --git a/src/hydrogenflux_cahnhilliard.f90 b/src/hydrogenflux_cahnhilliard.f90 index 569be97dc..3a42a49e1 100644 --- a/src/hydrogenflux_cahnhilliard.f90 +++ b/src/hydrogenflux_cahnhilliard.f90 @@ -81,7 +81,8 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) hydrogenfluxMapping, & hydrogenConc, & hydrogenConcRate, & - hydrogenflux_initialCh, & + hydrogenflux_initialCh + use config, only: & material_partHomogenization, & material_partPhase diff --git a/src/hydrogenflux_isoconc.f90 b/src/hydrogenflux_isoconc.f90 index d1b13aa76..836d29198 100644 --- a/src/hydrogenflux_isoconc.f90 +++ b/src/hydrogenflux_isoconc.f90 @@ -27,6 +27,7 @@ subroutine hydrogenflux_isoconc_init() use IO, only: & IO_timeStamp use material + use config implicit none integer(pInt) :: & diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 74af0a52d..998b19562 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -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: & diff --git a/src/kinematics_hydrogen_strain.f90 b/src/kinematics_hydrogen_strain.f90 index f3ea4df38..516ca286f 100644 --- a/src/kinematics_hydrogen_strain.f90 +++ b/src/kinematics_hydrogen_strain.f90 @@ -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 diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index ba38ac05b..61ff84b9f 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -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: & diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 0de483d70..3cec1da4c 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -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 diff --git a/src/kinematics_vacancy_strain.f90 b/src/kinematics_vacancy_strain.f90 index 227a86e0c..7ecc7fe6e 100644 --- a/src/kinematics_vacancy_strain.f90 +++ b/src/kinematics_vacancy_strain.f90 @@ -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 diff --git a/src/lattice.f90 b/src/lattice.f90 index 37393b82e..386001c76 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -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 diff --git a/src/material.f90 b/src/material.f90 index 25d115520..2b83c9967 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -1,6 +1,7 @@ !-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief Parses material config file, either solverJobName.materialConfig or material.config !> @details reads the material configuration file, where solverJobName.materialConfig takes !! precedence over material.config and parses the sections 'homogenization', 'crystallite', @@ -141,15 +142,6 @@ module material HOMOGENIZATION_rgc_ID end enum - 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 - - 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 - integer(kind(ELASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: & phase_elasticity !< elasticity of each phase integer(kind(PLASTICITY_undefined_ID)), dimension(:), allocatable, public, protected :: & @@ -173,17 +165,8 @@ module material integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:), allocatable, public, protected :: & homogenization_type !< type of each homogenization - 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 - integer(pInt), public, protected :: & - homogenization_maxNgrains, & !< max number of grains in any USED homogenization - material_Nphase, & !< number of phases - material_Nhomogenization, & !< number of homogenizations - material_Nmicrostructure, & !< number of microstructures - material_Ncrystallite !< number of crystallite settings + homogenization_maxNgrains !< max number of grains in any USED homogenization integer(pInt), dimension(:), allocatable, public, protected :: & phase_Nsources, & !< number of source mechanisms active in each phase @@ -242,19 +225,10 @@ module material phase_localPlasticity !< flags phases with local constitutive law - character(len=*), parameter, private :: & - MATERIAL_partMicrostructure = 'microstructure', & !< keyword for microstructure part - MATERIAL_partTexture = 'texture' !< keyword for texture part - - character(len=64), dimension(:), allocatable, private :: & - microstructure_name, & !< name of each microstructure - texture_name !< name of each texture - - character(len=256), dimension(:), allocatable, private :: & + character(len=65536), dimension(:), allocatable, private :: & texture_ODFfile !< name of each ODF file integer(pInt), private :: & - material_Ntexture, & !< number of textures microstructure_maxNconstituents, & !< max number of constituents in any phase texture_maxNgauss, & !< max number of Gauss components in any texture texture_maxNfiber !< max number of Fiber components in any texture @@ -371,22 +345,29 @@ subroutine material_init() #endif use IO, only: & IO_error, & - IO_open_file, & - IO_open_jobFile_stat, & IO_timeStamp use debug, only: & debug_level, & debug_material, & debug_levelBasic, & debug_levelExtensive + use config, only: & + config_crystallite, & + config_homogenization, & + config_microstructure, & + config_phase, & + config_texture, & + homogenization_name, & + microstructure_name, & + phase_name, & + texture_name, & + config_deallocate use mesh, only: & mesh_maxNips, & mesh_NcpElems, & mesh_element, & FE_Nips, & FE_geomtype - use numerics, only: & - worldrank implicit none integer(pInt), parameter :: FILEUNIT = 200_pInt @@ -402,64 +383,63 @@ subroutine material_init() myDebug = debug_level(debug_material) - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- material init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- material init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess - 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 - call material_parseHomogenization(FILEUNIT,material_partHomogenization) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) - call material_parseMicrostructure(FILEUNIT,material_partMicrostructure) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) - call material_parseCrystallite(FILEUNIT,material_partCrystallite) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) - call material_parseTexture(FILEUNIT,material_partTexture) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) - call material_parsePhase(FILEUNIT,material_partPhase) + call material_parsePhase() if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) - close(FILEUNIT) + + call material_parseMicrostructure() + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) + + call material_parseCrystallite() + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) + + call material_parseHomogenization() + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) + + call material_parseTexture() + if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) - allocate(plasticState (material_Nphase)) - allocate(sourceState (material_Nphase)) - do myPhase = 1,material_Nphase + allocate(plasticState (size(config_phase))) + allocate(sourceState (size(config_phase))) + do myPhase = 1,size(config_phase) allocate(sourceState(myPhase)%p(phase_Nsources(myPhase))) enddo - allocate(homogState (material_Nhomogenization)) - allocate(thermalState (material_Nhomogenization)) - allocate(damageState (material_Nhomogenization)) - allocate(vacancyfluxState (material_Nhomogenization)) - allocate(porosityState (material_Nhomogenization)) - allocate(hydrogenfluxState (material_Nhomogenization)) + allocate(homogState (size(config_homogenization))) + allocate(thermalState (size(config_homogenization))) + allocate(damageState (size(config_homogenization))) + allocate(vacancyfluxState (size(config_homogenization))) + allocate(porosityState (size(config_homogenization))) + allocate(hydrogenfluxState (size(config_homogenization))) - allocate(thermalMapping (material_Nhomogenization)) - allocate(damageMapping (material_Nhomogenization)) - allocate(vacancyfluxMapping (material_Nhomogenization)) - allocate(porosityMapping (material_Nhomogenization)) - allocate(hydrogenfluxMapping(material_Nhomogenization)) + allocate(thermalMapping (size(config_homogenization))) + allocate(damageMapping (size(config_homogenization))) + allocate(vacancyfluxMapping (size(config_homogenization))) + allocate(porosityMapping (size(config_homogenization))) + allocate(hydrogenfluxMapping(size(config_homogenization))) - allocate(temperature (material_Nhomogenization)) - allocate(damage (material_Nhomogenization)) - allocate(vacancyConc (material_Nhomogenization)) - allocate(porosity (material_Nhomogenization)) - allocate(hydrogenConc (material_Nhomogenization)) + allocate(temperature (size(config_homogenization))) + allocate(damage (size(config_homogenization))) + allocate(vacancyConc (size(config_homogenization))) + allocate(porosity (size(config_homogenization))) + allocate(hydrogenConc (size(config_homogenization))) - allocate(temperatureRate (material_Nhomogenization)) - allocate(vacancyConcRate (material_Nhomogenization)) - allocate(hydrogenConcRate (material_Nhomogenization)) + allocate(temperatureRate (size(config_homogenization))) + allocate(vacancyConcRate (size(config_homogenization))) + allocate(hydrogenConcRate (size(config_homogenization))) - do m = 1_pInt,material_Nmicrostructure + do m = 1_pInt,size(config_microstructure) if(microstructure_crystallite(m) < 1_pInt .or. & - microstructure_crystallite(m) > material_Ncrystallite) & + microstructure_crystallite(m) > size(config_crystallite)) & call IO_error(150_pInt,m,ext_msg='crystallite') if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & - maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > material_Nphase) & + maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(config_phase)) & call IO_error(150_pInt,m,ext_msg='phase') if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. & - maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > material_Ntexture) & + maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > size(config_texture)) & call IO_error(150_pInt,m,ext_msg='texture') if(microstructure_Nconstituents(m) < 1_pInt) & call IO_error(151_pInt,m) @@ -468,11 +448,11 @@ subroutine material_init() debugOut: if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then write(6,'(/,a,/)') ' MATERIAL configuration' write(6,'(a32,1x,a16,1x,a6)') 'homogenization ','type ','grains' - do h = 1_pInt,material_Nhomogenization + do h = 1_pInt,size(config_homogenization) write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h) enddo write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous' - do m = 1_pInt,material_Nmicrostructure + do m = 1_pInt,size(config_microstructure) write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), & microstructure_crystallite(m), & microstructure_Nconstituents(m), & @@ -489,6 +469,7 @@ subroutine material_init() endif debugOut call material_populateGrains + call config_deallocate('material.config/microstructure') allocate(phaseAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) allocate(phasememberAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) @@ -496,9 +477,9 @@ subroutine material_init() allocate(mappingCrystallite (2,homogenization_maxNgrains, mesh_NcpElems),source=0_pInt) allocate(mappingHomogenizationConst( mesh_maxNips,mesh_NcpElems),source=1_pInt) - allocate(ConstitutivePosition (material_Nphase), source=0_pInt) - allocate(HomogenizationPosition(material_Nhomogenization),source=0_pInt) - allocate(CrystallitePosition (material_Nphase), source=0_pInt) + allocate(ConstitutivePosition (size(config_phase)), source=0_pInt) + allocate(HomogenizationPosition(size(config_homogenization)),source=0_pInt) + allocate(CrystallitePosition (size(config_phase)), source=0_pInt) ElemLoop:do e = 1_pInt,mesh_NcpElems myHomog = mesh_element(3,e) @@ -515,7 +496,7 @@ subroutine material_init() enddo ElemLoop ! hack needed to initialize field values used during constitutive and crystallite initializations - do myHomog = 1,material_Nhomogenization + do myHomog = 1,size(config_homogenization) thermalMapping (myHomog)%p => mappingHomogenizationConst damageMapping (myHomog)%p => mappingHomogenizationConst vacancyfluxMapping (myHomog)%p => mappingHomogenizationConst @@ -530,195 +511,159 @@ subroutine material_init() allocate(vacancyConcRate (myHomog)%p(1), source=0.0_pReal) allocate(hydrogenConcRate(myHomog)%p(1), source=0.0_pReal) enddo - + end subroutine material_init !-------------------------------------------------------------------------------------------------- -!> @brief parses the homogenization part in the material configuration file +!> @brief parses the homogenization part from the material configuration !-------------------------------------------------------------------------------------------------- -subroutine material_parseHomogenization(fileUnit,myPart) +subroutine material_parseHomogenization + use config, only : & + config_homogenization use IO, only: & - IO_read, & - IO_globalTagInPart, & - IO_countSections, & - IO_error, & - IO_countTagInPart, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_stringPos, & - IO_EOF + IO_error use mesh, only: & mesh_element implicit none - character(len=*), intent(in) :: myPart - integer(pInt), intent(in) :: fileUnit + integer(pInt) :: h + character(len=65536) :: tag + + allocate(homogenization_type(size(config_homogenization)), source=HOMOGENIZATION_undefined_ID) + allocate(thermal_type(size(config_homogenization)), source=THERMAL_isothermal_ID) + allocate(damage_type (size(config_homogenization)), source=DAMAGE_none_ID) + allocate(vacancyflux_type(size(config_homogenization)), source=VACANCYFLUX_isoconc_ID) + allocate(porosity_type (size(config_homogenization)), source=POROSITY_none_ID) + allocate(hydrogenflux_type(size(config_homogenization)), source=HYDROGENFLUX_isoconc_ID) + allocate(homogenization_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(thermal_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(damage_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(vacancyflux_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(porosity_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(hydrogenflux_typeInstance(size(config_homogenization)), source=0_pInt) + allocate(homogenization_Ngrains(size(config_homogenization)), source=0_pInt) + allocate(homogenization_Noutput(size(config_homogenization)), source=0_pInt) + allocate(homogenization_active(size(config_homogenization)), source=.false.) !!!!!!!!!!!!!!! + allocate(thermal_initialT(size(config_homogenization)), source=300.0_pReal) + allocate(damage_initialPhi(size(config_homogenization)), source=1.0_pReal) + allocate(vacancyflux_initialCv(size(config_homogenization)), source=0.0_pReal) + allocate(porosity_initialPhi(size(config_homogenization)), source=1.0_pReal) + allocate(hydrogenflux_initialCh(size(config_homogenization)), source=0.0_pReal) + + forall (h = 1_pInt:size(config_homogenization)) homogenization_active(h) = any(mesh_element(3,:) == h) - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, s, p - character(len=65536) :: & - tag, line - logical :: echo + do h=1_pInt, size(config_homogenization) + homogenization_Noutput(h) = config_homogenization(h)%countKeys('(output)') - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') - Nsections = IO_countSections(fileUnit,myPart) - material_Nhomogenization = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) + tag = config_homogenization(h)%getString('mech') + select case (trim(tag)) + case(HOMOGENIZATION_NONE_label) + homogenization_type(h) = HOMOGENIZATION_NONE_ID + homogenization_Ngrains(h) = 1_pInt + case(HOMOGENIZATION_ISOSTRAIN_label) + homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID + homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') + case(HOMOGENIZATION_RGC_label) + homogenization_type(h) = HOMOGENIZATION_RGC_ID + homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents') + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h)) - allocate(homogenization_name(Nsections)); homogenization_name = '' - allocate(homogenization_type(Nsections), source=HOMOGENIZATION_undefined_ID) - allocate(thermal_type(Nsections), source=THERMAL_isothermal_ID) - allocate(damage_type (Nsections), source=DAMAGE_none_ID) - allocate(vacancyflux_type(Nsections), source=VACANCYFLUX_isoconc_ID) - allocate(porosity_type (Nsections), source=POROSITY_none_ID) - allocate(hydrogenflux_type(Nsections), source=HYDROGENFLUX_isoconc_ID) - allocate(homogenization_typeInstance(Nsections), source=0_pInt) - allocate(thermal_typeInstance(Nsections), source=0_pInt) - allocate(damage_typeInstance(Nsections), source=0_pInt) - allocate(vacancyflux_typeInstance(Nsections), source=0_pInt) - allocate(porosity_typeInstance(Nsections), source=0_pInt) - allocate(hydrogenflux_typeInstance(Nsections), source=0_pInt) - allocate(homogenization_Ngrains(Nsections), source=0_pInt) - allocate(homogenization_Noutput(Nsections), source=0_pInt) - allocate(homogenization_active(Nsections), source=.false.) !!!!!!!!!!!!!!! - allocate(thermal_initialT(Nsections), source=300.0_pReal) - allocate(damage_initialPhi(Nsections), source=1.0_pReal) - allocate(vacancyflux_initialCv(Nsections), source=0.0_pReal) - allocate(porosity_initialPhi(Nsections), source=1.0_pReal) - allocate(hydrogenflux_initialCh(Nsections), source=0.0_pReal) - - forall (s = 1_pInt:Nsections) homogenization_active(s) = any(mesh_element(3,:) == s) ! current homogenization used in model? Homogenization view, maximum operations depend on maximum number of homog schemes - homogenization_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections) - - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header - - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - homogenization_name(section) = IO_getTag(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 ('type','mech','mechanical') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(HOMOGENIZATION_NONE_label) - homogenization_type(section) = HOMOGENIZATION_NONE_ID - homogenization_Ngrains(section) = 1_pInt - case(HOMOGENIZATION_ISOSTRAIN_label) - homogenization_type(section) = HOMOGENIZATION_ISOSTRAIN_ID - case(HOMOGENIZATION_RGC_label) - homogenization_type(section) = HOMOGENIZATION_RGC_ID - case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - homogenization_typeInstance(section) = & - count(homogenization_type==homogenization_type(section)) ! count instances - case ('thermal') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(THERMAL_isothermal_label) - thermal_type(section) = THERMAL_isothermal_ID - case(THERMAL_adiabatic_label) - thermal_type(section) = THERMAL_adiabatic_ID - case(THERMAL_conduction_label) - thermal_type(section) = THERMAL_conduction_ID - case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - - case ('damage') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(DAMAGE_NONE_label) - damage_type(section) = DAMAGE_none_ID - case(DAMAGE_LOCAL_label) - damage_type(section) = DAMAGE_local_ID - case(DAMAGE_NONLOCAL_label) - damage_type(section) = DAMAGE_nonlocal_ID - case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - - case ('vacancyflux') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(VACANCYFLUX_isoconc_label) - vacancyflux_type(section) = VACANCYFLUX_isoconc_ID - case(VACANCYFLUX_isochempot_label) - vacancyflux_type(section) = VACANCYFLUX_isochempot_ID - case(VACANCYFLUX_cahnhilliard_label) - vacancyflux_type(section) = VACANCYFLUX_cahnhilliard_ID - case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - - case ('porosity') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(POROSITY_NONE_label) - porosity_type(section) = POROSITY_none_ID - case(POROSITY_phasefield_label) - porosity_type(section) = POROSITY_phasefield_ID - case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - - case ('hydrogenflux') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case(HYDROGENFLUX_isoconc_label) - hydrogenflux_type(section) = HYDROGENFLUX_isoconc_ID - case(HYDROGENFLUX_cahnhilliard_label) - hydrogenflux_type(section) = HYDROGENFLUX_cahnhilliard_ID - case default - call IO_error(500_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - - case ('nconstituents','ngrains') - homogenization_Ngrains(section) = IO_intValue(line,chunkPos,2_pInt) - - case ('initialtemperature','initialt') - thermal_initialT(section) = IO_floatValue(line,chunkPos,2_pInt) - - case ('initialdamage') - damage_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) - - case ('initialvacancyconc','initialcv') - vacancyflux_initialCv(section) = IO_floatValue(line,chunkPos,2_pInt) - - case ('initialporosity') - porosity_initialPhi(section) = IO_floatValue(line,chunkPos,2_pInt) - - case ('initialhydrogenconc','initialch') - hydrogenflux_initialCh(section) = IO_floatValue(line,chunkPos,2_pInt) + if (config_homogenization(h)%keyExists('thermal')) then + thermal_initialT(h) = config_homogenization(h)%getFloat('t0',defaultVal=300.0_pReal) + tag = config_homogenization(h)%getString('thermal') + select case (trim(tag)) + case(THERMAL_isothermal_label) + thermal_type(h) = THERMAL_isothermal_ID + case(THERMAL_adiabatic_label) + thermal_type(h) = THERMAL_adiabatic_ID + case(THERMAL_conduction_label) + thermal_type(h) = THERMAL_conduction_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) end select + endif + + if (config_homogenization(h)%keyExists('damage')) then + damage_initialPhi(h) = config_homogenization(h)%getFloat('initialdamage',defaultVal=1.0_pReal) + + tag = config_homogenization(h)%getString('damage') + select case (trim(tag)) + case(DAMAGE_NONE_label) + damage_type(h) = DAMAGE_none_ID + case(DAMAGE_LOCAL_label) + damage_type(h) = DAMAGE_local_ID + case(DAMAGE_NONLOCAL_label) + damage_type(h) = DAMAGE_nonlocal_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + endif + + if (config_homogenization(h)%keyExists('vacancyflux')) then + vacancyflux_initialCv(h) = config_homogenization(h)%getFloat('cv0',defaultVal=0.0_pReal) + + tag = config_homogenization(h)%getString('vacancyflux') + select case (trim(tag)) + case(VACANCYFLUX_isoconc_label) + vacancyflux_type(h) = VACANCYFLUX_isoconc_ID + case(VACANCYFLUX_isochempot_label) + vacancyflux_type(h) = VACANCYFLUX_isochempot_ID + case(VACANCYFLUX_cahnhilliard_label) + vacancyflux_type(h) = VACANCYFLUX_cahnhilliard_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + endif + + if (config_homogenization(h)%keyExists('porosity')) then + !ToDo? + + tag = config_homogenization(h)%getString('porosity') + select case (trim(tag)) + case(POROSITY_NONE_label) + porosity_type(h) = POROSITY_none_ID + case(POROSITY_phasefield_label) + porosity_type(h) = POROSITY_phasefield_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + endif + + if (config_homogenization(h)%keyExists('hydrogenflux')) then + hydrogenflux_initialCh(h) = config_homogenization(h)%getFloat('ch0',defaultVal=0.0_pReal) + + tag = config_homogenization(h)%getString('hydrogenflux') + select case (trim(tag)) + case(HYDROGENFLUX_isoconc_label) + hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID + case(HYDROGENFLUX_cahnhilliard_label) + hydrogenflux_type(h) = HYDROGENFLUX_cahnhilliard_ID + case default + call IO_error(500_pInt,ext_msg=trim(tag)) + end select + + endif + enddo - do p=1_pInt, Nsections - homogenization_typeInstance(p) = count(homogenization_type(1:p) == homogenization_type(p)) - thermal_typeInstance(p) = count(thermal_type (1:p) == thermal_type (p)) - damage_typeInstance(p) = count(damage_type (1:p) == damage_type (p)) - vacancyflux_typeInstance(p) = count(vacancyflux_type (1:p) == vacancyflux_type (p)) - porosity_typeInstance(p) = count(porosity_type (1:p) == porosity_type (p)) - hydrogenflux_typeInstance(p) = count(hydrogenflux_type (1:p) == hydrogenflux_type (p)) + do h=1_pInt, size(config_homogenization) + homogenization_typeInstance(h) = count(homogenization_type(1:h) == homogenization_type(h)) + thermal_typeInstance(h) = count(thermal_type (1:h) == thermal_type (h)) + damage_typeInstance(h) = count(damage_type (1:h) == damage_type (h)) + vacancyflux_typeInstance(h) = count(vacancyflux_type (1:h) == vacancyflux_type (h)) + porosity_typeInstance(h) = count(porosity_type (1:h) == porosity_type (h)) + hydrogenflux_typeInstance(h) = count(hydrogenflux_type (1:h) == hydrogenflux_type (h)) enddo homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active) @@ -729,159 +674,93 @@ end subroutine material_parseHomogenization !-------------------------------------------------------------------------------------------------- !> @brief parses the microstructure part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine material_parseMicrostructure(fileUnit,myPart) +subroutine material_parseMicrostructure use prec, only: & dNeq - use IO + use IO, only: & + IO_floatValue, & + IO_intValue, & + IO_stringValue, & + IO_stringPos, & + IO_error + use config, only: & + config_microstructure, & + microstructure_name use mesh, only: & mesh_element, & mesh_NcpElems implicit none - character(len=*), intent(in) :: myPart - integer(pInt), intent(in) :: fileUnit - + character(len=65536), dimension(:), allocatable :: & + str integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, constituent, e, i + integer(pInt) :: e, m, c, i character(len=65536) :: & - tag, line - logical :: echo + tag - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') + allocate(microstructure_crystallite(size(config_microstructure)), source=0_pInt) + allocate(microstructure_Nconstituents(size(config_microstructure)), source=0_pInt) + allocate(microstructure_active(size(config_microstructure)), source=.false.) + allocate(microstructure_elemhomo(size(config_microstructure)), source=.false.) - Nsections = IO_countSections(fileUnit,myPart) - material_Nmicrostructure = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) - - allocate(microstructure_name(Nsections)); microstructure_name = '' - allocate(microstructure_crystallite(Nsections), source=0_pInt) - allocate(microstructure_Nconstituents(Nsections), source=0_pInt) - allocate(microstructure_active(Nsections), source=.false.) - allocate(microstructure_elemhomo(Nsections), source=.false.) - - if(any(mesh_element(4,1:mesh_NcpElems) > Nsections)) & + if(any(mesh_element(4,1:mesh_NcpElems) > size(config_microstructure))) & call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') forall (e = 1_pInt:mesh_NcpElems) microstructure_active(mesh_element(4,e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements - microstructure_Nconstituents = IO_countTagInPart(fileUnit,myPart,'(constituent)',Nsections) + do m=1_pInt, size(config_microstructure) + microstructure_Nconstituents(m) = config_microstructure(m)%countKeys('(constituent)') + microstructure_crystallite(m) = config_microstructure(m)%getInt('crystallite') + microstructure_elemhomo(m) = config_microstructure(m)%keyExists('/elementhomogeneous/') + enddo + microstructure_maxNconstituents = maxval(microstructure_Nconstituents) - microstructure_elemhomo = IO_spotTagInPart(fileUnit,myPart,'/elementhomogeneous/',Nsections) + allocate(microstructure_phase (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt) + allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt) + allocate(microstructure_fraction(microstructure_maxNconstituents,size(config_microstructure)),source=0.0_pReal) - allocate(microstructure_phase (microstructure_maxNconstituents,Nsections),source=0_pInt) - allocate(microstructure_texture (microstructure_maxNconstituents,Nsections),source=0_pInt) - allocate(microstructure_fraction(microstructure_maxNconstituents,Nsections),source=0.0_pReal) + do m=1_pInt, size(config_microstructure) + str = config_microstructure(m)%getStrings('(constituent)',raw=.true.) + do c = 1_pInt, size(str) + chunkPos = IO_stringPos(str(c)) - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - constituent = 0_pInt ! - " - + do i = 1_pInt,5_pInt,2_pInt + tag = IO_stringValue(str(c),chunkPos,i) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header - - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - constituent = 0_pInt - microstructure_name(section) = IO_getTag(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 ('crystallite') - microstructure_crystallite(section) = IO_intValue(line,chunkPos,2_pInt) - case ('(constituent)') - constituent = constituent + 1_pInt - do i = 2_pInt,6_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,chunkPos,i)) - select case (tag) - case('phase') - microstructure_phase(constituent,section) = IO_intValue(line,chunkPos,i+1_pInt) - case('texture') - microstructure_texture(constituent,section) = IO_intValue(line,chunkPos,i+1_pInt) - case('fraction') - microstructure_fraction(constituent,section) = IO_floatValue(line,chunkPos,i+1_pInt) - end select - enddo - end select - endif + select case (tag) + case('phase') + microstructure_phase(c,m) = IO_intValue(str(c),chunkPos,i+1_pInt) + case('texture') + microstructure_texture(c,m) = IO_intValue(str(c),chunkPos,i+1_pInt) + case('fraction') + microstructure_fraction(c,m) = IO_floatValue(str(c),chunkPos,i+1_pInt) + end select + + enddo + enddo enddo - !sanity check -do section = 1_pInt, Nsections - if (dNeq(sum(microstructure_fraction(:,section)),1.0_pReal)) & - call IO_error(153_pInt,ext_msg=microstructure_name(section)) -enddo - + do m = 1_pInt, size(config_microstructure) + if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) & + call IO_error(153_pInt,ext_msg=microstructure_name(m)) + enddo + end subroutine material_parseMicrostructure !-------------------------------------------------------------------------------------------------- !> @brief parses the crystallite part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine material_parseCrystallite(fileUnit,myPart) - use IO, only: & - IO_read, & - IO_countSections, & - IO_error, & - IO_countTagInPart, & - IO_globalTagInPart, & - IO_getTag, & - IO_lc, & - IO_isBlank, & - IO_EOF +subroutine material_parseCrystallite + use config, only: & + config_crystallite implicit none - character(len=*), intent(in) :: myPart - integer(pInt), intent(in) :: fileUnit + integer(pInt) :: c - integer(pInt) :: Nsections, & - section - character(len=65536) :: line - logical :: echo - - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') - - Nsections = IO_countSections(fileUnit,myPart) - material_Ncrystallite = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) - - allocate(crystallite_name(Nsections)); crystallite_name = '' - allocate(crystallite_Noutput(Nsections), source=0_pInt) - - crystallite_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections) - - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header - - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - crystallite_name(section) = IO_getTag(line,'[',']') - endif + allocate(crystallite_Noutput(size(config_crystallite)),source=0_pInt) + do c=1_pInt, size(config_crystallite) + crystallite_Noutput(c) = config_crystallite(c)%countKeys('(output)') enddo end subroutine material_parseCrystallite @@ -890,163 +769,139 @@ end subroutine material_parseCrystallite !-------------------------------------------------------------------------------------------------- !> @brief parses the phase part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine material_parsePhase(fileUnit,myPart) +subroutine material_parsePhase use IO, only: & - IO_read, & - IO_globalTagInPart, & - IO_countSections, & IO_error, & - IO_countTagInPart, & IO_getTag, & - IO_spotTagInPart, & - IO_lc, & - IO_isBlank, & - IO_stringValue, & - IO_stringPos, & - IO_EOF + IO_stringValue + use config, only: & + config_phase implicit none - character(len=*), intent(in) :: myPart - integer(pInt), intent(in) :: fileUnit + integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p + character(len=65536), dimension(:), allocatable :: str - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, sourceCtr, kinematicsCtr, stiffDegradationCtr, p - character(len=65536) :: & - tag,line - logical :: echo + allocate(phase_elasticity(size(config_phase)),source=ELASTICITY_undefined_ID) + allocate(phase_plasticity(size(config_phase)),source=PLASTICITY_undefined_ID) + allocate(phase_Nsources(size(config_phase)), source=0_pInt) + allocate(phase_Nkinematics(size(config_phase)), source=0_pInt) + allocate(phase_NstiffnessDegradations(size(config_phase)),source=0_pInt) + allocate(phase_Noutput(size(config_phase)), source=0_pInt) + allocate(phase_localPlasticity(size(config_phase)), source=.false.) - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') + do p=1_pInt, size(config_phase) + phase_Noutput(p) = config_phase(p)%countKeys('(output)') + phase_Nsources(p) = config_phase(p)%countKeys('(source)') + phase_Nkinematics(p) = config_phase(p)%countKeys('(kinematics)') + phase_NstiffnessDegradations(p) = config_phase(p)%countKeys('(stiffness_degradation)') + phase_localPlasticity(p) = .not. config_phase(p)%KeyExists('/nonlocal/') - Nsections = IO_countSections(fileUnit,myPart) - material_Nphase = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) + select case (config_phase(p)%getString('elasticity')) + case (ELASTICITY_HOOKE_label) + phase_elasticity(p) = ELASTICITY_HOOKE_ID + case default + call IO_error(200_pInt,ext_msg=trim(config_phase(p)%getString('elasticity'))) + end select - allocate(phase_name(Nsections)); phase_name = '' - allocate(phase_elasticity(Nsections), source=ELASTICITY_undefined_ID) - allocate(phase_elasticityInstance(Nsections), source=0_pInt) - allocate(phase_plasticity(Nsections) , source=PLASTICITY_undefined_ID) - allocate(phase_plasticityInstance(Nsections), source=0_pInt) - allocate(phase_Nsources(Nsections), source=0_pInt) - allocate(phase_Nkinematics(Nsections), source=0_pInt) - allocate(phase_NstiffnessDegradations(Nsections),source=0_pInt) - allocate(phase_Noutput(Nsections), source=0_pInt) - allocate(phase_localPlasticity(Nsections), source=.false.) + select case (config_phase(p)%getString('plasticity')) + case (PLASTICITY_NONE_label) + phase_plasticity(p) = PLASTICITY_NONE_ID + case (PLASTICITY_ISOTROPIC_label) + phase_plasticity(p) = PLASTICITY_ISOTROPIC_ID + case (PLASTICITY_PHENOPOWERLAW_label) + phase_plasticity(p) = PLASTICITY_PHENOPOWERLAW_ID + case (PLASTICITY_KINEHARDENING_label) + phase_plasticity(p) = PLASTICITY_KINEHARDENING_ID + case (PLASTICITY_DISLOTWIN_label) + phase_plasticity(p) = PLASTICITY_DISLOTWIN_ID + case (PLASTICITY_DISLOUCLA_label) + phase_plasticity(p) = PLASTICITY_DISLOUCLA_ID + case (PLASTICITY_NONLOCAL_label) + phase_plasticity(p) = PLASTICITY_NONLOCAL_ID + case default + call IO_error(201_pInt,ext_msg=trim(config_phase(p)%getString('plasticity'))) + end select - phase_Noutput = IO_countTagInPart(fileUnit,myPart,'(output)',Nsections) - phase_Nsources = IO_countTagInPart(fileUnit,myPart,'(source)',Nsections) - phase_Nkinematics = IO_countTagInPart(fileUnit,myPart,'(kinematics)',Nsections) - phase_NstiffnessDegradations = IO_countTagInPart(fileUnit,myPart,'(stiffness_degradation)',Nsections) - phase_localPlasticity = .not. IO_spotTagInPart(fileUnit,myPart,'/nonlocal/',Nsections) + enddo - allocate(phase_source(maxval(phase_Nsources),Nsections), source=SOURCE_undefined_ID) - allocate(phase_kinematics(maxval(phase_Nkinematics),Nsections), source=KINEMATICS_undefined_ID) - allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),Nsections), & + allocate(phase_source(maxval(phase_Nsources),size(config_phase)), source=SOURCE_undefined_ID) + allocate(phase_kinematics(maxval(phase_Nkinematics),size(config_phase)), source=KINEMATICS_undefined_ID) + allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(config_phase)), & source=STIFFNESS_DEGRADATION_undefined_ID) - - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header - - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - sourceCtr = 0_pInt - kinematicsCtr = 0_pInt - stiffDegradationCtr = 0_pInt - phase_name(section) = IO_getTag(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 ('elasticity') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (ELASTICITY_HOOKE_label) - phase_elasticity(section) = ELASTICITY_HOOKE_ID - case default - call IO_error(200_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - case ('plasticity') - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (PLASTICITY_NONE_label) - phase_plasticity(section) = PLASTICITY_NONE_ID - case (PLASTICITY_ISOTROPIC_label) - phase_plasticity(section) = PLASTICITY_ISOTROPIC_ID - case (PLASTICITY_PHENOPOWERLAW_label) - phase_plasticity(section) = PLASTICITY_PHENOPOWERLAW_ID - case (PLASTICITY_KINEHARDENING_label) - phase_plasticity(section) = PLASTICITY_KINEHARDENING_ID - case (PLASTICITY_DISLOTWIN_label) - phase_plasticity(section) = PLASTICITY_DISLOTWIN_ID - case (PLASTICITY_DISLOUCLA_label) - phase_plasticity(section) = PLASTICITY_DISLOUCLA_ID - case (PLASTICITY_NONLOCAL_label) - phase_plasticity(section) = PLASTICITY_NONLOCAL_ID - case default - call IO_error(201_pInt,ext_msg=trim(IO_stringValue(line,chunkPos,2_pInt))) - end select - case ('(source)') - sourceCtr = sourceCtr + 1_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (SOURCE_thermal_dissipation_label) - phase_source(sourceCtr,section) = SOURCE_thermal_dissipation_ID - case (SOURCE_thermal_externalheat_label) - phase_source(sourceCtr,section) = SOURCE_thermal_externalheat_ID - case (SOURCE_damage_isoBrittle_label) - phase_source(sourceCtr,section) = SOURCE_damage_isoBrittle_ID - case (SOURCE_damage_isoDuctile_label) - phase_source(sourceCtr,section) = SOURCE_damage_isoDuctile_ID - case (SOURCE_damage_anisoBrittle_label) - phase_source(sourceCtr,section) = SOURCE_damage_anisoBrittle_ID - case (SOURCE_damage_anisoDuctile_label) - phase_source(sourceCtr,section) = SOURCE_damage_anisoDuctile_ID - case (SOURCE_vacancy_phenoplasticity_label) - phase_source(sourceCtr,section) = SOURCE_vacancy_phenoplasticity_ID - case (SOURCE_vacancy_irradiation_label) - phase_source(sourceCtr,section) = SOURCE_vacancy_irradiation_ID - case (SOURCE_vacancy_thermalfluc_label) - phase_source(sourceCtr,section) = SOURCE_vacancy_thermalfluc_ID - end select - case ('(kinematics)') - kinematicsCtr = kinematicsCtr + 1_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (KINEMATICS_cleavage_opening_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_cleavage_opening_ID - case (KINEMATICS_slipplane_opening_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_slipplane_opening_ID - case (KINEMATICS_thermal_expansion_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_thermal_expansion_ID - case (KINEMATICS_vacancy_strain_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_vacancy_strain_ID - case (KINEMATICS_hydrogen_strain_label) - phase_kinematics(kinematicsCtr,section) = KINEMATICS_hydrogen_strain_ID - end select - case ('(stiffness_degradation)') - stiffDegradationCtr = stiffDegradationCtr + 1_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case (STIFFNESS_DEGRADATION_damage_label) - phase_stiffnessDegradation(stiffDegradationCtr,section) = STIFFNESS_DEGRADATION_damage_ID - case (STIFFNESS_DEGRADATION_porosity_label) - phase_stiffnessDegradation(stiffDegradationCtr,section) = STIFFNESS_DEGRADATION_porosity_ID - end select - + do p=1_pInt, size(config_phase) +#if defined(__GFORTRAN__) + str = ['GfortranBug86277'] + str = config_phase(p)%getStrings('(source)',defaultVal=str) + if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] +#else + str = config_phase(p)%getStrings('(source)',defaultVal=[character(len=65536)::]) +#endif + do sourceCtr = 1_pInt, size(str) + select case (trim(str(sourceCtr))) + case (SOURCE_thermal_dissipation_label) + phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID + case (SOURCE_thermal_externalheat_label) + phase_source(sourceCtr,p) = SOURCE_thermal_externalheat_ID + case (SOURCE_damage_isoBrittle_label) + phase_source(sourceCtr,p) = SOURCE_damage_isoBrittle_ID + case (SOURCE_damage_isoDuctile_label) + phase_source(sourceCtr,p) = SOURCE_damage_isoDuctile_ID + case (SOURCE_damage_anisoBrittle_label) + phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID + case (SOURCE_damage_anisoDuctile_label) + phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID + case (SOURCE_vacancy_phenoplasticity_label) + phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID + case (SOURCE_vacancy_irradiation_label) + phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID + case (SOURCE_vacancy_thermalfluc_label) + phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID end select - endif + enddo + +#if defined(__GFORTRAN__) + str = ['GfortranBug86277'] + str = config_phase(p)%getStrings('(kinematics)',defaultVal=str) + if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] +#else + str = config_phase(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::]) +#endif + do kinematicsCtr = 1_pInt, size(str) + select case (trim(str(kinematicsCtr))) + case (KINEMATICS_cleavage_opening_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID + case (KINEMATICS_slipplane_opening_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID + case (KINEMATICS_thermal_expansion_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID + case (KINEMATICS_vacancy_strain_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID + case (KINEMATICS_hydrogen_strain_label) + phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID + end select + enddo +#if defined(__GFORTRAN__) + str = ['GfortranBug86277'] + str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=str) + if (str(1) == 'GfortranBug86277') str = [character(len=65536)::] +#else + str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=65536)::]) +#endif + do stiffDegradationCtr = 1_pInt, size(str) + select case (trim(str(stiffDegradationCtr))) + case (STIFFNESS_DEGRADATION_damage_label) + phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID + case (STIFFNESS_DEGRADATION_porosity_label) + phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID + end select + enddo enddo - do p=1_pInt, Nsections + allocate(phase_plasticityInstance(size(config_phase)), source=0_pInt) + allocate(phase_elasticityInstance(size(config_phase)), source=0_pInt) + + do p=1_pInt, size(config_phase) phase_elasticityInstance(p) = count(phase_elasticity(1:p) == phase_elasticity(p)) phase_plasticityInstance(p) = count(phase_plasticity(1:p) == phase_plasticity(p)) enddo @@ -1056,184 +911,156 @@ end subroutine material_parsePhase !-------------------------------------------------------------------------------------------------- !> @brief parses the texture part in the material configuration file !-------------------------------------------------------------------------------------------------- -subroutine material_parseTexture(fileUnit,myPart) +subroutine material_parseTexture use prec, only: & dNeq use IO, only: & - IO_read, & - IO_globalTagInPart, & - IO_countSections, & IO_error, & - IO_countTagInPart, & - IO_getTag, & - IO_spotTagInPart, & - IO_lc, & - IO_isBlank, & - IO_floatValue, & - IO_stringValue, & IO_stringPos, & - IO_EOF + IO_floatValue, & + IO_stringValue + use config, only: & + config_texture, & + config_deallocate use math, only: & inRad, & math_sampleRandomOri, & math_I3, & - math_det33, & - math_inv33 + math_det33 implicit none - character(len=*), intent(in) :: myPart - integer(pInt), intent(in) :: fileUnit - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: Nsections, section, gauss, fiber, j + integer(pInt) :: section, gauss, fiber, j, t, i + character(len=65536), dimension(:), allocatable :: strings ! Values for given key in material config + integer(pInt), dimension(:), allocatable :: chunkPos character(len=65536) :: tag - character(len=65536) :: line - logical :: echo - echo = IO_globalTagInPart(fileUnit,myPart,'/echo/') + allocate(texture_ODFfile(size(config_texture))); texture_ODFfile='' + allocate(texture_symmetry(size(config_texture)), source=1_pInt) + allocate(texture_Ngauss(size(config_texture)), source=0_pInt) + allocate(texture_Nfiber(size(config_texture)), source=0_pInt) - Nsections = IO_countSections(fileUnit,myPart) - material_Ntexture = Nsections - if (Nsections < 1_pInt) call IO_error(160_pInt,ext_msg=myPart) + do t=1_pInt, size(config_texture) + texture_Ngauss(t) = config_texture(t)%countKeys('(gauss)') & + + config_texture(t)%countKeys('(random)') + texture_Nfiber(t) = config_texture(t)%countKeys('(fiber)') + enddo - allocate(texture_name(Nsections)); texture_name='' - allocate(texture_ODFfile(Nsections)); texture_ODFfile='' - allocate(texture_symmetry(Nsections), source=1_pInt) - allocate(texture_Ngauss(Nsections), source=0_pInt) - allocate(texture_Nfiber(Nsections), source=0_pInt) - - texture_Ngauss = IO_countTagInPart(fileUnit,myPart,'(gauss)', Nsections) + & - IO_countTagInPart(fileUnit,myPart,'(random)',Nsections) - texture_Nfiber = IO_countTagInPart(fileUnit,myPart,'(fiber)', Nsections) texture_maxNgauss = maxval(texture_Ngauss) texture_maxNfiber = maxval(texture_Nfiber) - allocate(texture_Gauss (5,texture_maxNgauss,Nsections), source=0.0_pReal) - allocate(texture_Fiber (6,texture_maxNfiber,Nsections), source=0.0_pReal) - allocate(texture_transformation(3,3,Nsections), source=0.0_pReal) - texture_transformation = spread(math_I3,3,Nsections) + allocate(texture_Gauss (5,texture_maxNgauss,size(config_texture)), source=0.0_pReal) + allocate(texture_Fiber (6,texture_maxNfiber,size(config_texture)), source=0.0_pReal) + allocate(texture_transformation(3,3,size(config_texture)), source=0.0_pReal) + texture_transformation = spread(math_I3,3,size(config_texture)) - rewind(fileUnit) - line = '' ! to have in initialized - section = 0_pInt ! - " - - gauss = 0_pInt ! - " - - fiber = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= myPart) ! wind forward to - line = IO_read(fileUnit) - enddo - if (echo) write(6,'(/,1x,a)') trim(line) ! echo part header - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit + do t=1_pInt, size(config_texture) + section = t + gauss = 0_pInt + fiber = 0_pInt + + if (config_texture(t)%keyExists('axes')) then + strings = config_texture(t)%getStrings('axes') + do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries + select case (strings(j)) + case('x', '+x') + texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis + case('-x') + texture_transformation(j,1:3,t) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis + case('y', '+y') + texture_transformation(j,1:3,t) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis + case('-y') + texture_transformation(j,1:3,t) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis + case('z', '+z') + texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis + case('-z') + texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis + case default + call IO_error(157_pInt,t) + end select + enddo + if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157_pInt,t) endif - if (echo) write(6,'(2x,a)') trim(line) ! echo back read lines - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - gauss = 0_pInt - fiber = 0_pInt - texture_name(section) = IO_getTag(line,'[',']') + + tag='' + texture_ODFfile(t) = config_texture(t)%getString('hybridia',defaultVal=tag) + + if (config_texture(t)%keyExists('symmetry')) then + select case (config_texture(t)%getString('symmetry')) + case('orthotropic') + texture_symmetry(t) = 4_pInt + case('monoclinic') + texture_symmetry(t) = 2_pInt + case default + texture_symmetry(t) = 1_pInt + end select endif - if (section > 0_pInt) then - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - textureType: select case(tag) - case ('axes', 'rotation') textureType - do j = 1_pInt, 3_pInt ! look for "x", "y", and "z" entries - tag = IO_lc(IO_stringValue(line,chunkPos,j+1_pInt)) - select case (tag) - case('x', '+x') - texture_transformation(j,1:3,section) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now +x-axis - case('-x') - texture_transformation(j,1:3,section) = [-1.0_pReal, 0.0_pReal, 0.0_pReal] ! original axis is now -x-axis - case('y', '+y') - texture_transformation(j,1:3,section) = [ 0.0_pReal, 1.0_pReal, 0.0_pReal] ! original axis is now +y-axis - case('-y') - texture_transformation(j,1:3,section) = [ 0.0_pReal,-1.0_pReal, 0.0_pReal] ! original axis is now -y-axis - case('z', '+z') - texture_transformation(j,1:3,section) = [ 0.0_pReal, 0.0_pReal, 1.0_pReal] ! original axis is now +z-axis - case('-z') - texture_transformation(j,1:3,section) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal] ! original axis is now -z-axis - case default - call IO_error(157_pInt,section) - end select - enddo - - if(dNeq(math_det33(texture_transformation(1:3,1:3,section)),1.0_pReal)) & - call IO_error(157_pInt,section) - - case ('hybridia') textureType - texture_ODFfile(section) = IO_stringValue(line,chunkPos,2_pInt) - - case ('symmetry') textureType - tag = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case (tag) - case('orthotropic') - texture_symmetry(section) = 4_pInt - case('monoclinic') - texture_symmetry(section) = 2_pInt - case default - texture_symmetry(section) = 1_pInt + if (config_texture(t)%keyExists('(random)')) then + strings = config_texture(t)%getStrings('(random)',raw=.true.) + do i = 1_pInt, size(strings) + gauss = gauss + 1_pInt + texture_Gauss(1:3,gauss,t) = math_sampleRandomOri() + chunkPos = IO_stringPos(strings(i)) + do j = 1_pInt,3_pInt,2_pInt + select case (IO_stringValue(strings(i),chunkPos,j)) + case('scatter') + texture_Gauss(4,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('fraction') + texture_Gauss(5,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt) end select - - case ('(random)') textureType - gauss = gauss + 1_pInt - texture_Gauss(1:3,gauss,section) = math_sampleRandomOri() - do j = 2_pInt,4_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,chunkPos,j)) - select case (tag) - case('scatter') - texture_Gauss(4,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('fraction') - texture_Gauss(5,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - - case ('(gauss)') textureType - gauss = gauss + 1_pInt - do j = 2_pInt,10_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,chunkPos,j)) - select case (tag) - case('phi1') - texture_Gauss(1,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('phi') - texture_Gauss(2,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('phi2') - texture_Gauss(3,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('scatter') - texture_Gauss(4,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('fraction') - texture_Gauss(5,gauss,section) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - - case ('(fiber)') textureType - fiber = fiber + 1_pInt - do j = 2_pInt,12_pInt,2_pInt - tag = IO_lc(IO_stringValue(line,chunkPos,j)) - select case (tag) - case('alpha1') - texture_Fiber(1,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('alpha2') - texture_Fiber(2,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('beta1') - texture_Fiber(3,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('beta2') - texture_Fiber(4,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('scatter') - texture_Fiber(5,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt)*inRad - case('fraction') - texture_Fiber(6,fiber,section) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - - end select textureType + enddo + enddo endif - enddo + + + if (config_texture(t)%keyExists('(gauss)')) then + gauss = gauss + 1_pInt + strings = config_texture(t)%getStrings('(gauss)',raw= .true.) + do i = 1_pInt , size(strings) + chunkPos = IO_stringPos(strings(i)) + do j = 1_pInt,9_pInt,2_pInt + select case (IO_stringValue(strings(i),chunkPos,j)) + case('phi1') + texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('phi') + texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('phi2') + texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('scatter') + texture_Gauss(4,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('fraction') + texture_Gauss(5,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt) + end select + enddo + enddo + endif + + + if (config_texture(t)%keyExists('(fiber)')) then + fiber = fiber + 1_pInt + strings = config_texture(t)%getStrings('(fiber)',raw= .true.) + do i = 1_pInt, size(strings) + chunkPos = IO_stringPos(strings(i)) + do j = 1_pInt,11_pInt,2_pInt + select case (IO_stringValue(strings(i),chunkPos,j)) + case('alpha1') + texture_Fiber(1,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('alpha2') + texture_Fiber(2,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('beta1') + texture_Fiber(3,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('beta2') + texture_Fiber(4,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('scatter') + texture_Fiber(5,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad + case('fraction') + texture_Fiber(6,fiber,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt) + end select + enddo + enddo + endif + enddo + + call config_deallocate('material.config/texture') end subroutine material_parseTexture @@ -1262,6 +1089,11 @@ subroutine material_populateGrains mesh_ipVolume, & FE_Nips, & FE_geomtype + use config, only: & + config_homogenization, & + config_microstructure, & + homogenization_name, & + microstructure_name use IO, only: & IO_error, & IO_hybridIA @@ -1298,8 +1130,8 @@ subroutine material_populateGrains allocate(material_texture(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), source=0_pInt) allocate(material_EulerAngles(3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) - allocate(Ngrains(material_Nhomogenization,material_Nmicrostructure), source=0_pInt) - allocate(Nelems(material_Nhomogenization,material_Nmicrostructure), source=0_pInt) + allocate(Ngrains(size(config_homogenization),size(config_microstructure)), source=0_pInt) + allocate(Nelems (size(config_homogenization),size(config_microstructure)), source=0_pInt) ! populating homogenization schemes in each !-------------------------------------------------------------------------------------------------- @@ -1314,9 +1146,9 @@ subroutine material_populateGrains micro = mesh_element(4,e) Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt enddo - allocate(elemsOfHomogMicro(material_Nhomogenization,material_Nmicrostructure)) - do homog = 1,material_Nhomogenization - do micro = 1,material_Nmicrostructure + allocate(elemsOfHomogMicro(size(config_homogenization),size(config_microstructure))) + do homog = 1,size(config_homogenization) + do micro = 1,size(config_microstructure) if (Nelems(homog,micro) > 0_pInt) then allocate(elemsOfHomogMicro(homog,micro)%p(Nelems(homog,micro))) elemsOfHomogMicro(homog,micro)%p = 0_pInt @@ -1331,9 +1163,9 @@ subroutine material_populateGrains t = FE_geomtype(mesh_element(2,e)) homog = mesh_element(3,e) micro = mesh_element(4,e) - if (homog < 1_pInt .or. homog > material_Nhomogenization) & ! out of bounds + if (homog < 1_pInt .or. homog > size(config_homogenization)) & ! out of bounds call IO_error(154_pInt,e,0_pInt,0_pInt) - if (micro < 1_pInt .or. micro > material_Nmicrostructure) & ! out of bounds + if (micro < 1_pInt .or. micro > size(config_microstructure)) & ! out of bounds call IO_error(155_pInt,e,0_pInt,0_pInt) if (microstructure_elemhomo(micro)) then ! how many grains are needed at this element? dGrains = homogenization_Ngrains(homog) ! only one set of Ngrains (other IPs are plain copies) @@ -1351,22 +1183,17 @@ subroutine material_populateGrains allocate(orientationOfGrain(3,maxval(Ngrains)),source=0.0_pReal) ! reserve memory for maximum case if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - !$OMP CRITICAL (write2out) write(6,'(/,a/)') ' MATERIAL grain population' write(6,'(a32,1x,a32,1x,a6)') 'homogenization_name','microstructure_name','grain#' - !$OMP END CRITICAL (write2out) endif - homogenizationLoop: do homog = 1_pInt,material_Nhomogenization + homogenizationLoop: do homog = 1_pInt,size(config_homogenization) dGrains = homogenization_Ngrains(homog) ! grain number per material point - microstructureLoop: do micro = 1_pInt,material_Nmicrostructure ! all pairs of homog and micro + microstructureLoop: do micro = 1_pInt,size(config_microstructure) ! all pairs of homog and micro activePair: if (Ngrains(homog,micro) > 0_pInt) then myNgrains = Ngrains(homog,micro) ! assign short name for total number of grains to populate myNconstituents = microstructure_Nconstituents(micro) ! assign short name for number of constituents - if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - !$OMP CRITICAL (write2out) - write(6,'(/,a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains - !$OMP END CRITICAL (write2out) - endif + if (iand(myDebug,debug_levelBasic) /= 0_pInt) & + write(6,'(/,a32,1x,a32,1x,i6)') homogenization_name(homog),microstructure_name(micro),myNgrains !-------------------------------------------------------------------------------------------------- diff --git a/src/math.f90 b/src/math.f90 index 3c7f2d91c..39adcbba4 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -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) - - 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 - - call halton_memory ('GET', 'SEED', 1_pInt, value_halton) - seed = value_halton(1) - - call halton_memory ('GET', 'BASE', ndim, base) - - call i_to_halton (seed, base, ndim, r) - - value_halton(1) = 1_pInt - call halton_memory ('INC', 'SEED', 1_pInt, value_halton) - -!-------------------------------------------------------------------------------------------------- - 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 +!> @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 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 + 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) - if (first_call) then - ndim_save = 1_pInt - allocate(base(ndim_save)) - base(1) = 2_pInt - first_call = .false. - endif + current = current + 1_pInt + + base = prime(bases) + base_inv = 1.0_pReal/real(base,pReal) + + halton = 0.0_pReal + t = current + + 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 -!-------------------------------------------------------------------------------------------------- -! 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 !-------------------------------------------------------------------------------------------------- @@ -2820,5 +2632,5 @@ real(pReal) pure function math_limit(a, left, right) math_limit = merge (IEEE_value(1.0_pReal,IEEE_quiet_NaN),math_limit, left>right) end function math_limit - + end module math diff --git a/src/mesh.f90 b/src/mesh.f90 index 74bb55a3b..d5930490a 100644 --- a/src/mesh.f90 +++ b/src/mesh.f90 @@ -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 - 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 + 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" diff --git a/src/numerics.f90 b/src/numerics.f90 index c854d9d2b..27b04cd67 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -10,9 +10,6 @@ module numerics implicit none private -#ifdef PETSc -#include -#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 + 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) diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 514652397..7c4d87fff 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -151,8 +151,9 @@ subroutine plastic_disloUCLA_init(fileUnit) phase_Noutput, & PLASTICITY_DISLOUCLA_label, & PLASTICITY_DISLOUCLA_ID, & - material_phase, & - plasticState, & + material_phase, & + plasticState + use config, only: & MATERIAL_partPhase use lattice use numerics,only: & diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index e0da954a6..2ed8ebfdf 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -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: & diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index a3a1d5caf..264fe7e18 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -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 - 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,7 +304,8 @@ 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) norm_Tstar_dev = sqrt(squarenorm_Tstar_dev) @@ -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 diff --git a/src/plastic_kinematichardening.f90 b/src/plastic_kinematichardening.f90 index c33a14db6..5089cd5ca 100644 --- a/src/plastic_kinematichardening.f90 +++ b/src/plastic_kinematichardening.f90 @@ -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)))) :: & diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 55871737d..41666a34c 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -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 diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 229d03c26..8a6d8b145 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -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: & diff --git a/src/porosity_none.f90 b/src/porosity_none.f90 index c273baf3b..d8175cd9e 100644 --- a/src/porosity_none.f90 +++ b/src/porosity_none.f90 @@ -27,6 +27,7 @@ subroutine porosity_none_init() use IO, only: & IO_timeStamp use material + use config implicit none integer(pInt) :: & diff --git a/src/porosity_phasefield.f90 b/src/porosity_phasefield.f90 index 6ab7263e4..1975ba64c 100644 --- a/src/porosity_phasefield.f90 +++ b/src/porosity_phasefield.f90 @@ -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 diff --git a/src/prec.f90 b/src/prec.f90 index f35735780..2cdc533b6 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -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 diff --git a/src/source_damage_anisoBrittle.f90 b/src/source_damage_anisoBrittle.f90 index 22236a636..6b222c37c 100644 --- a/src/source_damage_anisoBrittle.f90 +++ b/src/source_damage_anisoBrittle.f90 @@ -91,9 +91,10 @@ subroutine source_damage_anisoBrittle_init(fileUnit) phase_Noutput, & SOURCE_damage_anisoBrittle_label, & SOURCE_damage_anisoBrittle_ID, & + material_phase, & + sourceState + use config, only: & material_Nphase, & - material_phase, & - sourceState, & MATERIAL_partPhase use numerics,only: & numerics_integrator diff --git a/src/source_damage_anisoDuctile.f90 b/src/source_damage_anisoDuctile.f90 index 944a65918..5978960fb 100644 --- a/src/source_damage_anisoDuctile.f90 +++ b/src/source_damage_anisoDuctile.f90 @@ -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 diff --git a/src/source_damage_isoBrittle.f90 b/src/source_damage_isoBrittle.f90 index b9fb2c22c..041761afe 100644 --- a/src/source_damage_isoBrittle.f90 +++ b/src/source_damage_isoBrittle.f90 @@ -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 diff --git a/src/source_damage_isoDuctile.f90 b/src/source_damage_isoDuctile.f90 index ed08e0a41..e843be728 100644 --- a/src/source_damage_isoDuctile.f90 +++ b/src/source_damage_isoDuctile.f90 @@ -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 diff --git a/src/source_thermal_dissipation.f90 b/src/source_thermal_dissipation.f90 index 7a4e85c75..994d26b41 100644 --- a/src/source_thermal_dissipation.f90 +++ b/src/source_thermal_dissipation.f90 @@ -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 diff --git a/src/source_thermal_externalheat.f90 b/src/source_thermal_externalheat.f90 index 2907ddf85..b7151aece 100644 --- a/src/source_thermal_externalheat.f90 +++ b/src/source_thermal_externalheat.f90 @@ -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 diff --git a/src/source_vacancy_irradiation.f90 b/src/source_vacancy_irradiation.f90 index 566d97e68..67b4cabcf 100644 --- a/src/source_vacancy_irradiation.f90 +++ b/src/source_vacancy_irradiation.f90 @@ -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 diff --git a/src/source_vacancy_phenoplasticity.f90 b/src/source_vacancy_phenoplasticity.f90 index 8834a067a..e20d8ec06 100644 --- a/src/source_vacancy_phenoplasticity.f90 +++ b/src/source_vacancy_phenoplasticity.f90 @@ -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 diff --git a/src/source_vacancy_thermalfluc.f90 b/src/source_vacancy_thermalfluc.f90 index 91047fbf2..cea52aa75 100644 --- a/src/source_vacancy_thermalfluc.f90 +++ b/src/source_vacancy_thermalfluc.f90 @@ -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 diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 index c6caf410d..def1af303 100644 --- a/src/spectral_damage.f90 +++ b/src/spectral_damage.f90 @@ -4,6 +4,10 @@ !> @brief Spectral solver for nonlocal damage !-------------------------------------------------------------------------------------------------- module spectral_damage +#include +#include + use PETScdmda + use PETScsnes use prec, only: & pInt, & pReal @@ -18,7 +22,6 @@ module spectral_damage implicit none private -#include 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 @@ -361,9 +349,6 @@ subroutine spectral_damage_forward() DM :: dm_local PetscScalar, dimension(:,:,:), pointer :: x_scal PetscErrorCode :: ierr - - external :: & - SNESGetDM if (cutBack) then damage_current = 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 diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 index eca92df9d..d2adcf9ba 100644 --- a/src/spectral_interface.f90 +++ b/src/spectral_interface.f90 @@ -11,9 +11,9 @@ module DAMASK_interface use prec, only: & pInt + implicit none private -#include 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 +#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 diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index bef70153d..b2b5e8173 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -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 +#include + use PETScdmda + use PETScsnes use prec, only: & pInt, & pReal @@ -16,10 +20,9 @@ module spectral_mech_basic implicit none private -#include 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 diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 index 02e0e0ab8..9e567f0c9 100644 --- a/src/spectral_mech_Polarisation.f90 +++ b/src/spectral_mech_Polarisation.f90 @@ -5,6 +5,10 @@ !> @brief Polarisation scheme solver !-------------------------------------------------------------------------------------------------- module spectral_mech_Polarisation +#include +#include + use PETScdmda + use PETScsnes use prec, only: & pInt, & pReal @@ -16,7 +20,6 @@ module spectral_mech_Polarisation implicit none private -#include 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 diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index ff318f395..8e5b95ab9 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -4,6 +4,10 @@ !> @brief Spectral solver for thermal conduction !-------------------------------------------------------------------------------------------------- module spectral_thermal +#include +#include + use PETScdmda + use PETScsnes use prec, only: & pInt, & pReal @@ -18,7 +22,6 @@ module spectral_thermal implicit none private -#include 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 @@ -246,15 +239,13 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load enddo; enddo; enddo 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 = ',& + call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr) + 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 diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 4289d7829..b209ab2ea 100644 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -5,6 +5,8 @@ !-------------------------------------------------------------------------------------------------- module spectral_utilities use, intrinsic :: iso_c_binding +#include + use PETScSys use prec, only: & pReal, & pInt @@ -13,7 +15,6 @@ module spectral_utilities implicit none private -#include 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 !< - 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 diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 07e12a20b..2740011b4 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -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 diff --git a/src/thermal_adiabatic.f90 b/src/thermal_adiabatic.f90 index 62ffabf9c..6a70ca7ee 100644 --- a/src/thermal_adiabatic.f90 +++ b/src/thermal_adiabatic.f90 @@ -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 diff --git a/src/thermal_conduction.f90 b/src/thermal_conduction.f90 index 151eb7aa3..16497040b 100644 --- a/src/thermal_conduction.f90 +++ b/src/thermal_conduction.f90 @@ -77,7 +77,8 @@ subroutine thermal_conduction_init(fileUnit) thermalMapping, & thermal_initialT, & temperature, & - temperatureRate, & + temperatureRate + use config, only: & material_partHomogenization implicit none diff --git a/src/thermal_isothermal.f90 b/src/thermal_isothermal.f90 index 68e09de8c..fb518fe24 100644 --- a/src/thermal_isothermal.f90 +++ b/src/thermal_isothermal.f90 @@ -27,6 +27,7 @@ subroutine thermal_isothermal_init() use IO, only: & IO_timeStamp use material + use config implicit none integer(pInt) :: & diff --git a/src/vacancyflux_cahnhilliard.f90 b/src/vacancyflux_cahnhilliard.f90 index e40772d11..cde2cb233 100644 --- a/src/vacancyflux_cahnhilliard.f90 +++ b/src/vacancyflux_cahnhilliard.f90 @@ -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 diff --git a/src/vacancyflux_isochempot.f90 b/src/vacancyflux_isochempot.f90 index f98379eba..761a0ba22 100644 --- a/src/vacancyflux_isochempot.f90 +++ b/src/vacancyflux_isochempot.f90 @@ -74,7 +74,8 @@ subroutine vacancyflux_isochempot_init(fileUnit) vacancyfluxMapping, & vacancyConc, & vacancyConcRate, & - vacancyflux_initialCv, & + vacancyflux_initialCv + use config, only: & material_partHomogenization implicit none diff --git a/src/vacancyflux_isoconc.f90 b/src/vacancyflux_isoconc.f90 index 470560206..135509aa1 100644 --- a/src/vacancyflux_isoconc.f90 +++ b/src/vacancyflux_isoconc.f90 @@ -27,6 +27,7 @@ subroutine vacancyflux_isoconc_init() use IO, only: & IO_timeStamp use material + use config implicit none integer(pInt) :: &