Merge branch 'development' into 21_removeperformanceprofiling

.gitlab-ci.yml

@@ -7,10 +7,7 @@ stages:
   - compileSpectralGNU
   - prepareSpectral
   - spectral
-  - compileMarc2014
+  - compileMarc2017
-  - compileMarc2014.2
-  - compileMarc2015
-  - compileMarc2016
   - 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"
+  IntelCompiler:                   "$IntelCompiler18_1"
-  GNUCompiler:                     "$GNUCompiler5_3"
+  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_GNU:                       "$MPICH3_2GNU7_3"
-  MPICH_Intel:                     "$MPICH3_2Intel17_0"
+  MPICH_Intel:                     "$MPICH3_2Intel18_1"
   # ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++
-  PETSc3_7_6MPICH3_2Intel17_0:     "Libraries/PETSc/3.7.6/Intel-17.0-MPICH-3.2"
+  PETSc3_9_1MPICH3_2Intel18_1:     "Libraries/PETSc/3.9.1/Intel-18.1-MPICH-3.2.1"
-  PETSc3_7_5MPICH3_2Intel17_0:     "Libraries/PETSc/3.7.5/Intel-17.0-MPICH-3.2"
+  PETSc3_9_1MPICH3_2GNU7_3:        "Libraries/PETSc/3.9.1/GNU-7.3-MPICH-3.2.1"
-  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"
   # ------------ Defaults ----------------------------------------------
-  PETSc_MPICH_Intel:               "$PETSc3_7_6MPICH3_2Intel17_0"
+  PETSc_MPICH_Intel:               "$PETSc3_9_1MPICH3_2Intel18_1"
-  PETSc_MPICH_GNU:                 "$PETSc3_7_5MPICH3_2GNU5_3"
+  PETSc_MPICH_GNU:                 "$PETSc3_9_1MPICH3_2GNU7_3"
   # ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++
   Abaqus2016:                      "FEM/Abaqus/2016"
   Abaqus2017:                      "FEM/Abaqus/2017"
-  MSC2014:                         "FEM/MSC/2014"
+  MSC2017:                         "FEM/MSC/2017"
-  MSC2014_2:                       "FEM/MSC/2014.2"
-  MSC2015:                         "FEM/MSC/2015"
-  MSC2016:                         "FEM/MSC/2016"
   # ------------ Defaults ----------------------------------------------
   Abaqus:                          "$Abaqus2017"
-  MSC:                             "$MSC2016"
+  MSC:                             "$MSC2017"
   # ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++
   Doxygen1_8_13:                   "Documentation/Doxygen/1.8.13"
   # ------------ Defaults ----------------------------------------------
@@ -324,42 +318,20 @@ HybridIA:
     - master
     - release
 
-###################################################################################################
+TextureComponents:
-Marc_compileIfort2014:
+  stage: spectral
-  stage: compileMarc2014
+  script: TextureComponents/test.py
-  script:
-    - module load $IntelCompiler16_0 $MSC2014
-    - Marc_compileIfort/test.py -m 2014
   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:
+Marc_compileIfort2017:
-  stage: compileMarc2015
+  stage: compileMarc2017
   script:
-    - module load $IntelCompiler16_0 $MSC2015
+    - module load $IntelCompiler17_0 $MSC2017
-    - Marc_compileIfort/test.py -m 2015
+    - Marc_compileIfort/test.py -m 2017
-  except:
-    - master
-    - release
-
-###################################################################################################
-Marc_compileIfort2016:
-  stage: compileMarc2016
-  script:
-    - module load $IntelCompiler16_0 $MSC2016
-    - Marc_compileIfort/test.py -m 2016
   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

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 "")
+if (PETSC_DIR STREQUAL "")
-  message (FATAL_ERROR "PETSC_DIR is not defined")
+  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")
+  if (OPTIMIZATION STREQUAL "OFF")
-      set (OPTIMIZATION_FLAGS    "-O0 -no-ip")
+    set (OPTIMIZATION_FLAGS    "-O0 -no-ip")
-  elseif ("${OPTIMIZATION}" STREQUAL "DEFENSIVE")
+  elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
-      set (OPTIMIZATION_FLAGS    "-O2")
+    set (OPTIMIZATION_FLAGS    "-O2")
-  elseif ("${OPTIMIZATION}" STREQUAL "AGGRESSIVE")
+  elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
-      set (OPTIMIZATION_FLAGS    "-ipo -O3 -no-prec-div -fp-model fast=2 -xHost")
+    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"
+    # -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")
+  if (OPTIMIZATION STREQUAL "OFF")
-      set (OPTIMIZATION_FLAGS "-O0"       )
+    set (OPTIMIZATION_FLAGS "-O0"       )
-  elseif ("${OPTIMIZATION}" STREQUAL "DEFENSIVE")
+  elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
-      set (OPTIMIZATION_FLAGS "-O2")
+    set (OPTIMIZATION_FLAGS "-O2")
-  elseif ("${OPTIMIZATION}" STREQUAL "AGGRESSIVE")
+  elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
-      set (OPTIMIZATION_FLAGS "-O3 -ffast-math -funroll-loops -ftree-vectorize")
+    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 ()

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

DAMASK_env.csh

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

DAMASK_env.sh

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

DAMASK_env.zsh

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

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
 }
 

Makefile

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

PRIVATE

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

VERSION

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

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)
+DAMASK_ROOT=$(canonicalPath "$DAMASK_ROOT/../")
-if [ ${BASH_SOURCE##*/} == "DAMASK.sh" ]; then
-  DAMASK_ROOT="$DAMASK_ROOT/.."
-fi
 
-DAMASK_ROOT=$(canonicalPath $DAMASK_ROOT)
 
 # shorthand command to change to DAMASK_ROOT directory
 eval "function DAMASK_root() { cd $DAMASK_ROOT; }"

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)
+function blink {
-if [ ${0:t:r} = 'DAMASK' ]; then
+  echo -e "\033[2;5m$1\033[0m"
-  DAMASK_ROOT=${0:a:h}'/..'
+}
-else
+
-  DAMASK_ROOT=${0:a:h}
+DAMASK_ROOT=$(canonicalPath "${0:a:h}'/..")
-fi
 
 # 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)
+SOLVER=$(which DAMASK_spectral || true 2>/dev/null)
-[ "x$SOLVER == x" ] && SOLVER='Not found!'
+[ "x$SOLVER" = "x" ] && SOLVER=$(blink 'Not found!')
 
-PROCESSING=$(type -p postResults || true 2>/dev/null)
+PROCESSING=$(which postResults || true 2>/dev/null)
-[ "x$PROCESSING == x" ] && PROCESSING='Not found!'
+[ "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" \

examples/SpectralMethod/Polycrystal/material.config

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

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
+# -free                           to use free-format FORTRAN 90 syntax
-# -O <0-3>                     optimization level
+# -O <0-3>                        optimization level
-# -fpp                         use FORTRAN preprocessor on source code
+# -fpp                            use FORTRAN preprocessor on source code
-# -openmp                      build with openMP support
+# -openmp                         build with openMP support
-# -w90 -w95                    suppress messages about use of non-standard Fortran (previous version of abaqus_v6.env only)
+# -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)
+# -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)
+# -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
+# -ftz                            flush underflow to zero
-# -diag-disable 5268           disable warnings about line length > 132 (only comments there anyway)
+# -diag-disable 5268              disable warnings about line length > 132 (only comments there anyway)
-# -implicitnone                assume no implicit types (e.g. i for integer)
+# -implicitnone                   assume no implicit types (e.g. i for integer)
-# -assume byterecl             count record length in bytes
+# -standard-semantics             sets standard (Fortran 2008) and some other conventions
-# -real-size 64 -DFLOAT=8      assume size of real to be 8 bytes, matches our definition of pReal
+# -assume nostd_mod_proc_name     avoid problems with libraries compiled without that option
-# -integer-size 32 -DINT=4     assume size of integer to be 4 bytes, matches our definition of pInt
+# -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)
 

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
+# -free                           to use free-format FORTRAN 90 syntax
-# -O <0-3>                     optimization level
+# -O <0-3>                        optimization level
-# -fpp                         use FORTRAN preprocessor on source code
+# -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)
-# -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)
-# -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)
-# -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
-# -ftz                         flush underflow to zero
+# -diag-disable 5268              disable warnings about line length > 132 (only comments there anyway)
-# -diag-disable 5268           disable warnings about line length > 132 (only comments there anyway)
+# -implicitnone                   assume no implicit types (e.g. i for integer)
-# -implicitnone                assume no implicit types (e.g. i for integer)
+# -standard-semantics             sets standard (Fortran 2008) and some other conventions
-# -assume byterecl             count record length in bytes
+# -assume nostd_mod_proc_name     avoid problems with libraries compiled without that option
-# -real-size 64 -DFLOAT=8      assume size of real to be 8 bytes, matches our definition of pReal
+# -real-size 64 -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
+# -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)
 

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"

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"

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"

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"

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"

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

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',''],
              }
 
 

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)

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 $<TARGET_OBJECTS:SYSTEM_ROUTINES>)
 
 add_library(PREC OBJECT "prec.f90")
-add_dependencies(PREC SYSTEM_ROUTINES)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:PREC>)
 
-if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
+if (PROJECT_NAME STREQUAL "DAMASK_spectral")
       add_library(DAMASK_INTERFACE OBJECT "spectral_interface.f90")
-elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
+elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
       add_library(DAMASK_INTERFACE OBJECT "FEM_interface.f90")
+else ()
+    message (FATAL_ERROR "Build target (PROJECT_NAME) is not defined")
 endif()
-add_dependencies(DAMASK_INTERFACE PREC)
+add_dependencies(DAMASK_INTERFACE PREC SYSTEM_ROUTINES)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_INTERFACE>)
 
 add_library(IO OBJECT "IO.f90")
@@ -38,6 +39,10 @@ add_library(DEBUG OBJECT "debug.f90")
 add_dependencies(DEBUG NUMERICS)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:DEBUG>)
 
+add_library(CONFIG OBJECT "config.f90")
+add_dependencies(CONFIG DEBUG)
+list(APPEND OBJECTFILES $<TARGET_OBJECTS:CONFIG>)
+
 add_library(FEsolving OBJECT "FEsolving.f90")
 add_dependencies(FEsolving DEBUG)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEsolving>)
@@ -47,11 +52,11 @@ add_dependencies(DAMASK_MATH FEsolving)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_MATH>)
 
 # SPECTRAL solver and FEM solver use different mesh files
-if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
+if (PROJECT_NAME STREQUAL "DAMASK_spectral")
       add_library(MESH OBJECT "mesh.f90")
       add_dependencies(MESH DAMASK_MATH)
       list(APPEND OBJECTFILES $<TARGET_OBJECTS:MESH>)
-elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
+elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
       add_library(FEZoo OBJECT "FEZoo.f90")
       add_dependencies(FEZoo DAMASK_MATH)
       list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEZoo>)
@@ -61,7 +66,7 @@ elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
 endif()
 
 add_library(MATERIAL OBJECT "material.f90")
-add_dependencies(MATERIAL MESH)
+add_dependencies(MATERIAL MESH CONFIG)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:MATERIAL>)
 
 add_library(DAMASK_HELPERS OBJECT "lattice.f90")
@@ -158,7 +163,7 @@ add_library(DAMASK_CPFE OBJECT "CPFEM2.f90")
 add_dependencies(DAMASK_CPFE DAMASK_ENGINE)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_CPFE>)
 
-if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
+if (PROJECT_NAME STREQUAL "DAMASK_spectral")
       add_library(SPECTRAL_UTILITIES OBJECT "spectral_utilities.f90")
       add_dependencies(SPECTRAL_UTILITIES DAMASK_CPFE)
       list(APPEND OBJECTFILES $<TARGET_OBJECTS:SPECTRAL_UTILITIES>)
@@ -170,13 +175,13 @@ if ("${PROJECT_NAME}" STREQUAL "DAMASK_spectral")
       "spectral_mech_Basic.f90")
       add_dependencies(SPECTRAL_SOLVER SPECTRAL_UTILITIES)
       list(APPEND OBJECTFILES $<TARGET_OBJECTS:SPECTRAL_SOLVER>)
-      if(NOT "${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY")
+      if(NOT CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
         add_executable(DAMASK_spectral "DAMASK_spectral.f90" ${OBJECTFILES})
       else()
         add_library(DAMASK_spectral OBJECT "DAMASK_spectral.f90")
       endif()
       add_dependencies(DAMASK_spectral SPECTRAL_SOLVER)
-elseif ("${PROJECT_NAME}" STREQUAL "DAMASK_FEM")
+elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
       add_library(FEM_UTILITIES OBJECT "FEM_utilities.f90")
       add_dependencies(FEM_UTILITIES DAMASK_CPFE)
 

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,&

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,&

src/C_routines.c

@@ -11,9 +11,9 @@
 
 int isdirectory_c(const char *dir){
   struct stat statbuf;
-  if(stat(dir, &statbuf) != 0)
+  if(stat(dir, &statbuf) != 0)                                                                      /* error */
-    return 0;
+    return 0;                                                                                       /* return "NO, this is not a directory" */
-  return S_ISDIR(statbuf.st_mode);
+  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);
+}

src/DAMASK_marc2014.2.f90

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

src/DAMASK_marc2014.f90

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

src/DAMASK_marc2015.f90

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

src/DAMASK_spectral.f90

@@ -12,6 +12,8 @@ program DAMASK_spectral
    compiler_version, &
    compiler_options
 #endif
+#include <petsc/finclude/petscsys.h>
+ use PETScsys
  use prec, only: &
    pInt, &
    pLongInt, &
@@ -70,7 +72,6 @@ program DAMASK_spectral
    DAMAGE_nonlocal_ID
  use spectral_utilities, only: &
    utilities_init, &
-   utilities_destroy, &
    tSolutionState, &
    tLoadCase, &
    cutBack, &
@@ -84,11 +85,8 @@ program DAMASK_spectral
  use spectral_damage
  use spectral_thermal
 
-
  implicit none
 
-#include <petsc/finclude/petscsys.h>
-
 !--------------------------------------------------------------------------------------------------
 ! variables related to information from load case and geom file
  real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal                                          !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
@@ -143,24 +141,17 @@ program DAMASK_spectral
  integer(pInt), parameter :: maxByteOut = 2147483647-4096                                           !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742
  integer(pInt), parameter :: maxRealOut = maxByteOut/pReal
  integer(pLongInt), dimension(2) :: outputIndex
- PetscErrorCode :: ierr
+ integer :: ierr
+
  external :: &
-   quit, &
+   quit
-   MPI_file_open, &
+
-   MPI_file_close, &
-   MPI_file_seek, &
-   MPI_file_get_position, &
-   MPI_file_write, &
-   MPI_abort, &
-   MPI_finalize, &
-   MPI_allreduce, &
-   PETScFinalize
 
 !--------------------------------------------------------------------------------------------------
 ! 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)
+         case (DAMASK_spectral_SolverBasic_label)
-           call basicPETSc_init
+           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, &
+     call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), &
-                         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)]), &
+                         int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), &
-                         (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)
+                 case (DAMASK_spectral_SolverBasic_label)
-                   call BasicPETSc_forward (&
+                   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)
+                   case (DAMASK_spectral_SolverBasic_label)
-                     solres(field) = BasicPETSC_solution (&
+                     solres(field) = Basic_solution (&
                          incInfo,timeinc,timeIncOld, &
                          stress_BC          = loadCases(currentLoadCase)%stress, &
                          rotation_BC        = loadCases(currentLoadCase)%rotation)
@@ -634,8 +624,8 @@ program DAMASK_spectral
            outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, &
                       min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
            call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
-                                         [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
+                                       [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
-                               (outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt),&
+                               int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),&
                                MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
            if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write')
          enddo
@@ -682,22 +672,12 @@ end program DAMASK_spectral
 !> stderr. Exit code 3 signals no severe problems, but some increments did not converge
 !--------------------------------------------------------------------------------------------------
 subroutine quit(stop_id)
+#include <petsc/finclude/petscsys.h>
+ use MPI
  use prec, only: &
    pInt
- use spectral_mech_Basic, only: &
-   BasicPETSC_destroy
- use spectral_mech_Polarisation, only: &
-   Polarisation_destroy
- use spectral_damage, only: &
-   spectral_damage_destroy
- use spectral_thermal, only: &
-   spectral_thermal_destroy
- use spectral_utilities, only: &
-   utilities_destroy
-
- implicit none
  
-#include <petsc/finclude/petscsys.h>
+ 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, &
+   PETScFinalize
-   MPI_finalize
-
- call BasicPETSC_destroy()
- call Polarisation_destroy()
- call spectral_damage_destroy()
- call spectral_thermal_destroy()
- call utilities_destroy()
 
  call PETScFinalize(ierr)
  if (ierr /= 0) write(6,'(a)') ' Error in PETScFinalize'

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)') ' 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)')   ' 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
+   endif foundNextPart
-   if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt                                    ! found [section] identifier
+   foundFirstSection: if (IO_getTag(line,'[',']') /= '') then
-   if (section == 0_pInt) then
+     line = IO_read(fileUnit, .true.)                                                               ! reset IO_read
-     chunkPos = IO_stringPos(line)
+     exit
-     if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) &                                ! match
+   endif foundFirstSection
-       IO_globalTagInPart = .true.
+   chunkPos = IO_stringPos(line)
-   endif
+   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)

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"

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

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: &
+ use config, only: &
-   material_phase, &
    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)
+           OutputPlasticityLoop: do o = 1_pInt,size(thisOutput(:,ins))
-             write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,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)
+           OutputSourceLoop: do o = 1_pInt,size(thisOutput(:,ins))
-             write(FILEUNIT,'(a,i4)') trim(thisOutput(o,ins))//char(9),thisSize(o,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
 

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_error
-   IO_EOF
  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 = '', &
+   tag = ''
-   line= ''
 
  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)
+                             size(config_crystallite)),         source=undefined_ID)
- allocate(crystallite_sizePostResults(material_Ncrystallite),source=0_pInt)
+ allocate(crystallite_sizePostResults(size(config_crystallite)),source=0_pInt)
  allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), &
-                                     material_Ncrystallite), source=0_pInt)
+                                     size(config_crystallite)), source=0_pInt)
 
- if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) &                                  !  no local material configuration present...
-   call IO_open_file(FILEUNIT,material_configFile)                                                  ! ...open material.config file
 
- do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partCrystallite)   ! wind forward to <crystallite>
+ do c = 1_pInt, size(config_crystallite)
-   line = IO_read(FILEUNIT)
+#if defined(__GFORTRAN__)
- enddo
+   str = ['GfortranBug86277']
-
+   str = config_crystallite(c)%getStrings('(output)',defaultVal=str)
- do while (trim(line) /= IO_EOF)                                                                    ! read through sections of crystallite part
+   if (str(1) == 'GfortranBug86277') str = [character(len=65536)::]
-   line = IO_read(FILEUNIT)
+#else
-   if (IO_isBlank(line)) cycle                                                                      ! skip empty lines
+   str = config_crystallite(c)%getStrings('(output)',defaultVal=[character(len=65536)::])
-   if (IO_getTag(line,'<','>') /= '') then                                                          ! stop at next part
+#endif
-     line = IO_read(FILEUNIT, .true.)                                                               ! reset IO_read
+   do o = 1_pInt, size(str)
-     exit
+     crystallite_output(o,c) = str(o)
-   endif
+     outputName: select case(str(o))
-   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))
            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
+   enddo
-   endif
  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))))
+                   transpose(math_inv33(crystallite_subF(1:3,1:3,ipc,ip,el))))
- crystallite_push33ToRef = math_mul33x33(math_transpose33(T),math_mul33x33(tensor33,T))
+ 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 >> Lpguess', transpose(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 >> Fi', transpose(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 >> 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 >> A',transpose(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 >> B',transpose(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 >> Lp_constitutive',transpose(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 >> 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 >> Li_constitutive', transpose(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 >> 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 >> Li_constitutive',transpose(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 >> 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
+              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',math_transpose33(crystallite_Fp(1:3,1:3,ipc,ip,el))
+   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',math_transpose33(crystallite_Fi(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) = &

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

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) :: &

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

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,'(/,a)')   ' <<<+-  homogenization init  -+>>>'
+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-   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
 

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) = &
+             case default
-                 IO_lc(IO_stringValue(line,chunkPos,2_pInt))
+               homogenization_RGC_Noutput(i) = homogenization_RGC_Noutput(i) -1_pInt  ! correct for invalid
 
            end select
          case ('clustersize')

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

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) :: &

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
 

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) :: &

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: &

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
 

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: &

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
 

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
 

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

src/math.f90

@@ -162,10 +162,8 @@ module math
    math_rotate_forward3333, &
    math_limit
  private :: &
-   halton, &
+   math_check, &
-   halton_memory, &
+   halton
-   halton_ndim_set, &
-   halton_seed_set
 
 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)
+function math_sampleGaussOri(center,FWHM)
- use prec, only: &
-   tol_math_check
 
  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) :: angle
- real(pReal), dimension(3) :: math_sampleGaussOri, disturb
+ real(pReal), dimension(3)   :: math_sampleGaussOri, axis
- real(pReal), dimension(3), parameter :: ORIGIN = 0.0_pReal
+ real(pReal), dimension(4)   :: rnd
- real(pReal), dimension(5) :: 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
+ else
-  ! Helming uses different distribution with Bessel functions
+   GaussConvolution: do
-  ! therefore the gauss scatter width has to be scaled differently
+     rnd = halton([8_pInt,3_pInt,6_pInt,11_pInt])
-   scatter = 0.95_pReal * noise
+     axis(1)    = rnd(1)*2.0_pReal-1.0_pReal                                                        ! uniform on [-1,1]
-   cosScatter = cos(scatter)
+     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)
+!> @brief draw a sample from an Gaussian distribution around given fiber texture and Full Width
-!--------------------------------------------------------------------------------------------------
+! at Half Maximum (FWHM)
-function math_sampleFiberOri(alpha,beta,noise)
+!-------------------------------------------------------------------------------------------------
- use prec, only: &
+function math_sampleFiberOri(alpha,beta,FWHM)
-   tol_math_check
 
  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), intent(in) :: FWHM
- real(pReal), dimension(3,3) :: oRot,fRot,pRot
+ real(pReal), dimension(3) :: math_sampleFiberOri,  &
- real(pReal) :: noise, scatter, cos2Scatter, angle
+   fInC,&                                                                                           !< fiber axis in crystal coordinate system
- integer(pInt), dimension(2,3), parameter :: ROTMAP = reshape([2_pInt,3_pInt,&
+   fInS,&                                                                                           !< fiber axis in sample coordinate system
-                                                               3_pInt,1_pInt,&
+   u
-                                                               1_pInt,2_pInt],[2,3])
+ real(pReal), dimension(3) :: rnd
- integer(pInt) :: i
+ 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
+ allocate(a(0))
-! therefore the gauss scatter width has to be scaled differently
+ allocate(idx(0))
- scatter = 0.95_pReal * noise
+ fInC = [sin(alpha(1))*cos(alpha(2)), sin(alpha(1))*sin(alpha(2)), cos(alpha(1))]
- cos2Scatter = cos(2.0_pReal*scatter)
+ fInS = [sin(beta(1))*cos(beta(2)),   sin(beta(1))*sin(beta(2)),   cos(beta(1))]
 
-! fiber axis in crystal coordinate system
+ R = math_EulerAxisAngleToR(math_crossproduct(fInC,fInS),-acos(dot_product(fInC,fInS)))             !< rotation to align fiber axis in crystal and sample 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))]
 
-! ---# rotation matrix from sample to crystal system #---
+ rnd = halton([7_pInt,10_pInt,3_pInt])
- angle = -acos(dot_product(fiberInC,fiberInS))
+ R = math_mul33x33(R,math_EulerAxisAngleToR(fInS,rnd(1)*2.0_pReal*PI))                              !< additional rotation (0..360deg) perpendicular to fiber axis
- 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
 
-! ---# rotation matrix about fiber axis (random angle) #---
+ if (FWHM > 0.1_pReal*INRAD) then
- do
+   reducedTo2D: do i=1_pInt,3_pInt
-   call halton(6_pInt,rnd)
+     if (i /= minloc(abs(fInS),1)) then
-   fRot = math_EulerAxisAngleToR(fiberInS,rnd(1)*2.0_pReal*pi)
+       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 #---
+     rejectionSampling: if (rnd(3) <= exp(-4.0_pReal*log(2.0_pReal)*(angle/FWHM)**2_pReal)) then
-! random axis pependicular to fiber axis
+       R = math_mul33x33(R,math_EulerAxisAngleToR(math_crossproduct(u,fInS),angle))                 ! tilt around direction of smallest component
-   axis(1:2) = rnd(2:3)
+       exit
-   if (abs(fiberInS(3)) > tol_math_check) then
+     endif rejectionSampling
-     axis(3)=-(axis(1)*fiberInS(1)+axis(2)*fiberInS(2))/fiberInS(3)
+     rnd = halton([7_pInt,10_pInt,3_pInt])
-   else if(abs(fiberInS(2)) > tol_math_check) then
+   enddo GaussConvolution
-     axis(3)=axis(2)
+ endif
-     axis(2)=-(axis(1)*fiberInS(1)+axis(3)*fiberInS(3))/fiberInS(2)
+ math_sampleFiberOri = math_RtoEuler(R)
-   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)))
 
 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
-!--------------------------------------------------------------------------------------------------
+!> @author Martin Diehl
-subroutine halton(ndim, r)
+!> @details Incrementally increasing elements of the Halton sequence for given bases (> 0)
- 
+!> @details Reference:
- implicit none
+!> @details J.H. Halton: On the efficiency of certain quasi-random sequences of points in evaluating 
- integer(pInt), intent(in)                   :: ndim                                                  !< dimension of the element
+!> @details multi-dimensional integrals, Numerische Mathematik, Volume 2, pages 84-90, 1960.
- real(pReal),   intent(out), dimension(ndim) :: r                                                     !< next element of the current Halton sequence
+!> @details Reference for prime numbers:
- integer(pInt), dimension(ndim) :: base
+!> @details Milton Abramowitz and Irene Stegun: Handbook of Mathematical Functions,
- integer(pInt) :: seed
+!> @details US Department of Commerce, 1964, pages 870-873.
- integer(pInt), dimension(1) :: value_halton
+!> @details Daniel Zwillinger: CRC Standard Mathematical Tables and Formulae,
-
+!> @details 30th Edition, CRC Press, 1996, pages 95-98.
- call halton_memory ('GET', 'SEED', 1_pInt, value_halton)
+!-------------------------------------------------------------------------------------------------
- seed = value_halton(1)
+function halton(bases)
-
- 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
    
-   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) :: & 
+ integer(pInt), intent(in), dimension(:):: &
-   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)
+   bases                                                                                            !< bases (prime number ID)
-   name_halton                                                                                      !< name of the quantity: BASE: Halton base(s), NDIM: spatial dimension, SEED: current Halton seed
+ real(pReal),               dimension(size(bases)) :: &
- integer(pInt), dimension(*), intent(inout) :: value_halton
+   halton
- integer(pInt), allocatable, save, dimension(:) :: base
+ integer(pInt), save :: &
- logical, save :: first_call = .true.
+   current = 1_pInt
- integer(pInt), intent(in) :: ndim                                                                  !< dimension of the quantity
+ real(pReal),               dimension(size(bases)) :: &
- integer(pInt), save :: ndim_save = 0_pInt, seed = 1_pInt
+   base_inv
- integer(pInt) :: i
+ 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
+ current = current + 1_pInt
-   ndim_save = 1_pInt
+
-   allocate(base(ndim_save))
+ base = prime(bases)
-   base(1) = 2_pInt
+ base_inv = 1.0_pReal/real(base,pReal)
-   first_call = .false.
+
- endif
+ 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
  
-!--------------------------------------------------------------------------------------------------
+end function halton
-! 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
 
 
 !--------------------------------------------------------------------------------------------------
@@ -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

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

src/numerics.f90

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

src/plastic_disloUCLA.f90

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

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: &

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, &
+     aTolFlowstress, &
-     aTolShear      = 1.0e-6_pReal, &
+     aTolShear, &
-     tausat_SinhFitA= 0.0_pReal, &
+     tausat_SinhFitA, &
-     tausat_SinhFitB= 0.0_pReal, &
+     tausat_SinhFitB, &
-     tausat_SinhFitC= 0.0_pReal, &
+     tausat_SinhFitC, &
-     tausat_SinhFitD= 0.0_pReal
+     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, &
+   plasticState
-   MATERIAL_partPhase
+ 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) :: &
+ integer(pInt) :: NipcMyPhase,i
-   outputtag = ''
+ character(len=65536), dimension(:), allocatable :: outputs
- integer(pInt) :: NipcMyPhase
 
  write(6,'(/,a)')   ' <<<+-  constitutive_'//PLASTICITY_ISOTROPIC_label//' init  -+>>>'
- write(6,'(/,a)')   ' Ma et al., Computational Materials Science, 109:323–329, 2015'
- write(6,'(/,a)')   ' https://doi.org/10.1016/j.commatsci.2015.07.041'
  write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
 #include "compilation_info.f90"
  
  maxNinstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt)
- if (maxNinstance == 0_pInt) return
-
  if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
    write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
 
- allocate(plastic_isotropic_sizePostResults(maxNinstance),                      source=0_pInt)
+! public variables
  allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt)
  allocate(plastic_isotropic_output(maxval(phase_Noutput), maxNinstance))
           plastic_isotropic_output = ''
  allocate(plastic_isotropic_Noutput(maxNinstance),                              source=0_pInt)
 
+! inernal variable 
  allocate(param(maxNinstance))                                                                      ! one container of parameters per instance
-
- rewind(fileUnit)
- phase = 0_pInt
- do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase)         ! wind forward to <phase>
-   line = IO_read(fileUnit)
- enddo
- 
- parsingFile: do while (trim(line) /= IO_EOF)                                                       ! read through sections of phase part
-   line = IO_read(fileUnit)
-   if (IO_isBlank(line)) cycle                                                                      ! skip empty lines
-   if (IO_getTag(line,'<','>') /= '') then                                                          ! stop at next part
-     line = IO_read(fileUnit, .true.)                                                               ! reset IO_read
-     exit                                                                                           
-   endif
-   if (IO_getTag(line,'[',']') /= '') then                                                          ! next section
-     phase = phase + 1_pInt                                                                         ! advance section counter
-     if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then
-       instance = phase_plasticityInstance(phase)                                                   ! count instances of my constitutive law
-       allocate(param(instance)%outputID(phase_Noutput(phase)))                                     ! allocate space for IDs of every requested output
-     endif
-     cycle                                                                                          ! skip to next line
-   endif
-   if (phase > 0_pInt) then; if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then           ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran
-     instance = phase_plasticityInstance(phase)                                                     ! which instance of my plasticity is present phase
-     chunkPos = IO_stringPos(line) 
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                              ! extract key
-
-     select case(tag)
-       case ('(output)')
-         outputtag = IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-         select case(outputtag)
-           case ('flowstress')
-             plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
-             param(instance)%outputID (plastic_isotropic_Noutput(instance)) = flowstress_ID
-             plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputtag
-           case ('strainrate')
-             plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
-             param(instance)%outputID (plastic_isotropic_Noutput(instance)) = strainrate_ID
-             plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputtag
-         end select
-
-       case ('/dilatation/')
-         param(instance)%dilatation      = .true.
-
-       case ('tau0')
-         param(instance)%tau0            = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('gdot0')
-         param(instance)%gdot0           = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('n')
-         param(instance)%n               = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('h0')
-         param(instance)%h0              = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('h0_slope','slopelnrate')
-         param(instance)%h0_slopeLnRate  = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('tausat')
-         param(instance)%tausat          = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('tausat_sinhfita')
-         param(instance)%tausat_SinhFitA = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('tausat_sinhfitb')
-         param(instance)%tausat_SinhFitB = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('tausat_sinhfitc')
-         param(instance)%tausat_SinhFitC = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('tausat_sinhfitd')
-         param(instance)%tausat_SinhFitD = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('a', 'w0')
-         param(instance)%a               = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('taylorfactor')
-         param(instance)%fTaylor         = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('atol_flowstress')
-         param(instance)%aTolFlowstress  = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('atol_shear')
-         param(instance)%aTolShear       = IO_floatValue(line,chunkPos,2_pInt)
-
-       case default
-
-     end select
-   endif; endif
- enddo parsingFile
-
  allocate(state(maxNinstance))                                                                      ! internal state aliases
- allocate(state0(maxNinstance))
  allocate(dotState(maxNinstance))
- allocate(stateAbsTol(maxNinstance))
 
- initializeInstances: do phase = 1_pInt, size(phase_plasticity)                                     ! loop over every plasticity
+ do phase = 1_pInt, size(phase_plasticityInstance)
-   myPhase: if (phase_plasticity(phase) == PLASTICITY_isotropic_ID) then                            ! isolate instances of own constitutive description
+   if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then
-     NipcMyPhase = count(material_phase == phase)                                                   ! number of own material points (including point components ipc)
      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
+     extmsg = ''
-     if (param(instance)%tau0              < 0.0_pReal) extmsg = trim(extmsg)//' tau0'
+     if (prm%aTolShear        <= 0.0_pReal) extmsg = trim(extmsg)//"'aTolShear' "
-     if (param(instance)%gdot0            <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0'
+     if (prm%tau0              < 0.0_pReal) extmsg = trim(extmsg)//"'tau0' "
-     if (param(instance)%n                <= 0.0_pReal) extmsg = trim(extmsg)//' n'
+     if (prm%gdot0            <= 0.0_pReal) extmsg = trim(extmsg)//"'gdot0' "
-     if (param(instance)%tausat           <= 0.0_pReal) extmsg = trim(extmsg)//' tausat'
+     if (prm%n                <= 0.0_pReal) extmsg = trim(extmsg)//"'n' "
-     if (param(instance)%a                <= 0.0_pReal) extmsg = trim(extmsg)//' a' 
+     if (prm%tausat           <= prm%tau0)    extmsg = trim(extmsg)//"'tausat' "
-     if (param(instance)%fTaylor          <= 0.0_pReal) extmsg = trim(extmsg)//' taylorfactor'
+     if (prm%a                <= 0.0_pReal) extmsg = trim(extmsg)//"'a' " 
-     if (param(instance)%aTolFlowstress   <= 0.0_pReal) extmsg = trim(extmsg)//' atol_flowstress'
+     if (prm%fTaylor          <= 0.0_pReal) extmsg = trim(extmsg)//"'m' "
-     if (extmsg /= '') then 
+     if (prm%aTolFlowstress   <= 0.0_pReal) extmsg = trim(extmsg)//"'atol_flowstress' "
-       extmsg = trim(extmsg)//' ('//PLASTICITY_ISOTROPIC_label//')'                                 ! prepare error message identifier
+     if (extmsg /= '') call IO_error(211_pInt,ip=instance,&
-       call IO_error(211_pInt,ip=instance,ext_msg=extmsg)
+                            ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')')
-     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
 
 !--------------------------------------------------------------------------------------------------
 ! 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)
 
-!--------------------------------------------------------------------------------------------------
+endif
-! locally defined state aliases
+ enddo
-     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
 
 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_mul33xx33
-   math_transpose33
  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 &
+   gamma_dot = prm%gdot0 &
-             * ( sqrt(1.5_pReal) * norm_Tstar_dev / param(instance)%fTaylor / state(instance)%flowstress(of) ) &
+             * ( sqrt(1.5_pReal) * norm_Tstar_dev / prm%fTaylor / state(instance)%flowstress(of) ) &
-             **param(instance)%n
+             **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
+ 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 = param(instance)%gdot0 &
+   gamma_dot = prm%gdot0 &
-               * (sqrt(1.5_pReal) * norm_Tstar_sph / param(instance)%fTaylor / state(instance)%flowstress(of) ) &
+               * (sqrt(1.5_pReal) * norm_Tstar_sph / prm%fTaylor / state(instance)%flowstress(of) ) &
-               **param(instance)%n
+               **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
+   if (dEq0(prm%tausat_SinhFitA)) then
-     saturation = param(instance)%tausat
+     saturation = prm%tausat
    else
-     saturation = param(instance)%tausat &
+     saturation = prm%tausat &
-                + asinh( (gamma_dot / param(instance)%tausat_SinhFitA&
+                + asinh( (gamma_dot / prm%tausat_SinhFitA&
-                         )**(1.0_pReal / param(instance)%tausat_SinhFitD)&
+                         )**(1.0_pReal / prm%tausat_SinhFitD)&
-                       )**(1.0_pReal / param(instance)%tausat_SinhFitC) &
+                       )**(1.0_pReal / prm%tausat_SinhFitC) &
-                   / ( param(instance)%tausat_SinhFitB &
+                   / ( prm%tausat_SinhFitB &
-                       * (gamma_dot / param(instance)%gdot0)**(1.0_pReal / param(instance)%n) &
+                       * (gamma_dot / prm%gdot0)**(1.0_pReal / prm%n) &
                      )
    endif
-   hardening = ( param(instance)%h0 + param(instance)%h0_slopeLnRate * log(gamma_dot) ) &
+   hardening = ( prm%h0 + prm%h0_slopeLnRate * log(gamma_dot) ) &
-               * abs( 1.0_pReal - state(instance)%flowstress(of)/saturation )**param(instance)%a &
+               * 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

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_ID, &                                                                         !< critical resolved stress
-                 crss_back_ID, &                                                                          !< critical resolved back stress
+                 crss_back_ID, &                                                                    !< critical resolved back stress
-                 sense_ID, &                                                                              !< sense of acting shear stress (-1 or +1)
+                 sense_ID, &                                                                        !< sense of acting shear stress (-1 or +1)
-                 chi0_ID, &                                                                               !< backstress at last switch of stress sense (positive?)
+                 chi0_ID, &                                                                         !< backstress at last switch of stress sense (positive?)
-                 gamma0_ID, &                                                                             !< accumulated shear at last switch of stress sense (at current switch?)
+                 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)
+     gdot0, &                                                                                       !< reference shear strain rate for slip (input parameter)
-     n_slip, &                                                                                         !< stress exponent 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)
+     crss0, &                                                                                        !< initial critical shear stress for slip (input parameter, per family)
-     theta0, &                                                                                         !< initial hardening rate of forward stress for each slip
+     theta0, &                                                                                      !< initial hardening rate of forward stress for each slip
-     theta1, &                                                                                         !< asymptotic 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 > 
+     theta0_b, &                                                                                    !< initial hardening rate of back stress for each slip > 
-     theta1_b, &                                                                                       !< asymptotic 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
+   real(pReal), pointer, dimension(:,:) :: &                                                        !< vectors along NipcMyInstance
-     crss, &                                                                                           !< critical resolved stress
+     crss, &                                                                                        !< critical resolved stress
-     crss_back, &                                                                                      !< critical resolved back stress
+     crss_back, &                                                                                   !< critical resolved back stress
-     sense, &                                                                                          !< sense of acting shear stress (-1 or +1)
+     sense, &                                                                                       !< sense of acting shear stress (-1 or +1)
-     chi0, &                                                                                           !< backstress at last switch of stress sense
+     chi0, &                                                                                        !< backstress at last switch of stress sense
-     gamma0, &                                                                                         !< accumulated shear at last switch of stress sense
+     gamma0, &                                                                                      !< accumulated shear at last switch of stress sense
-     accshear                                                                                          !< accumulated (absolute) shear
+     accshear                                                                                       !< accumulated (absolute) shear
 
-   real(pReal), pointer, dimension(:) :: &                                                             !< scalars along NipcMyInstance
+   real(pReal), pointer, dimension(:) :: &                                                          !< scalars along NipcMyInstance
-     sumGamma                                                                                          !< accumulated shear across all systems
+     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
+           plastic_kinehardening_output(plastic_kinehardening_Noutput(instance),instance) = &
-           param(instance)%outputID (plastic_kinehardening_Noutput(instance)) = output_ID
+                                                          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 &
+     if (any(plastic_kinehardening_Nslip (1:nSlipFamilies,instance) > 0_pInt &
-             .and. param(instance)%crss0(1:nSlipFamilies)           < 0.0_pReal)) extmsg = trim(extmsg)//' crss0'
+             .and. param(instance)%crss0 (1:nSlipFamilies)          < 0.0_pReal)) extmsg = trim(extmsg)//' crss0'
-     if (any(plastic_kinehardening_Nslip(1:nSlipFamilies,instance) > 0_pInt &
+     if (any(plastic_kinehardening_Nslip (1:nSlipFamilies,instance) > 0_pInt &
-             .and. param(instance)%tau1(1:nSlipFamilies)          <= 0.0_pReal)) extmsg = trim(extmsg)//' tau1'
+             .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)%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_maxNslipFamily, &
-   lattice_NslipSystem, &
-   lattice_NnonSchmid
  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, &
+   f,i,j, &
-   index_myFamily,index_otherFamily, &
    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_NslipSystem
-   lattice_NnonSchmid
 
  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)))) :: &

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

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: &

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) :: &

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,'(/,a)')   ' <<<+-  porosity_'//POROSITY_phasefield_label//' init  -+>>>'
+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-   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

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

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

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

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

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
 

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

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

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

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

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

src/spectral_damage.f90

@@ -4,6 +4,10 @@
 !> @brief Spectral solver for nonlocal damage
 !--------------------------------------------------------------------------------------------------
 module spectral_damage
+#include <petsc/finclude/petscsnes.h>
+#include <petsc/finclude/petscdmda.h>
+ use PETScdmda
+ use PETScsnes
  use prec, only: & 
    pInt, &
    pReal
@@ -18,7 +22,6 @@ module spectral_damage
 
  implicit none
  private
-#include <petsc/finclude/petsc.h90>
 
  character (len=*), parameter, public :: &
    spectral_damage_label = 'spectraldamage'
@@ -46,13 +49,9 @@ module spectral_damage
  public :: &
    spectral_damage_init, &
    spectral_damage_solution, &
-   spectral_damage_forward, &
+   spectral_damage_forward
-   spectral_damage_destroy
  external :: &
-   PETScFinalize, &
+   PETScErrorF                                                                                      ! is called in the CHKERRQ macro
-   MPI_Abort, &
-   MPI_Bcast, &
-   MPI_Allreduce
 
 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, &
+   DMDAGetCorners, &
-   DMGetGlobalVector, &
+   DMDASNESSetFunctionLocal
-   DMRestoreGlobalVector, &
-   SNESVISetVariableBounds
 
  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, &
+   SNESSolve
-   SNESGetConvergedReason
 
  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) &
-   if (spectral_damage_solution%converged) &
+    write(6,'(/,a)') ' ... nonlocal damage converged .....................................'
-     write(6,'(/,a)') ' ... nonlocal damage converged .....................................'
+  write(6,'(/,a,f8.6,2x,f8.6,2x,f8.6,/)',advance='no') ' Minimum|Maximum|Delta Damage      = ',&
-   write(6,'(/,a,f8.6,2x,f8.6,2x,f8.6,/)',advance='no') ' Minimum|Maximum|Delta Damage      = ',&
                                                        minDamage, maxDamage, stagNorm
-   write(6,'(/,a)') ' ==========================================================================='
+ write(6,'(/,a)') ' ==========================================================================='
-   flush(6) 
+ flush(6) 
- endif 
 
 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
+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 module spectral_damage

src/spectral_interface.f90

@@ -11,9 +11,9 @@
 module DAMASK_interface
  use prec, only: &
    pInt
+
  implicit none
  private
-#include <petsc/finclude/petscsys.h>
  logical,             public, protected :: appendToOutFile = .false.                                !< Append to existing spectralOut file (in case of restart, not in case of regridding)
  integer(pInt),       public, protected :: spectralRestartInc = 0_pInt                              !< Increment at which calculation starts
  character(len=1024), public, protected :: &
@@ -44,7 +44,13 @@ contains
 subroutine DAMASK_interface_init()
  use, intrinsic :: &
    iso_fortran_env
-
+#include <petsc/finclude/petscsys.h>
+#if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR!=9
+=================================================================================================== 
+=========================   THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x   ========================= 
+===================================================================================================
+#endif
+ use PETScSys
  use system_routines, only: &
    getHostName
 
@@ -72,11 +78,8 @@ subroutine DAMASK_interface_init()
  logical        :: error
  external :: &
    quit,&
-   MPI_Comm_rank,&
+   PETScErrorF, &                                                                                   ! is called in the CHKERRQ macro
-   MPI_Comm_size,&
+   PETScInitialize
-   PETScInitialize, &
-   MPI_Init_Thread, &
-   MPI_abort
 
  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

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 <petsc/finclude/petscsnes.h>
+#include <petsc/finclude/petscdmda.h>
+ use PETScdmda
+ use PETScsnes
  use prec, only: & 
    pInt, &
    pReal
@@ -16,10 +20,9 @@ module spectral_mech_basic
 
  implicit none
  private
-#include <petsc/finclude/petsc.h90>
 
  character (len=*), parameter, public :: &
-   DAMASK_spectral_SolverBasicPETSC_label = 'basicpetsc'
+   DAMASK_spectral_SolverBasic_label = 'basic'
    
 !--------------------------------------------------------------------------------------------------
 ! derived types
@@ -62,22 +65,18 @@ module spectral_mech_basic
  real(pReal), private, dimension(3,3) :: mask_stress = 0.0_pReal
 
  public :: &
-   basicPETSc_init, &
+   basic_init, &
-   basicPETSc_solution, &
+   basic_solution, &
-   BasicPETSc_forward, &
+   basic_forward
-   basicPETSc_destroy
  external :: &
-   PETScFinalize, &
+   PETScErrorF                                                                                      ! is called in the CHKERRQ macro
-   MPI_Abort, &
-   MPI_Bcast, &
-   MPI_Allreduce
 
 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
-
+ PetscInt, dimension(:), allocatable :: localK  
- integer(pInt), 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 DMsetFromOptions(da,ierr); CHKERRQ(ierr)
- call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_OBJECT,ierr)     ! residual vector of same shape as solution vector
+ 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, &
+   SNESsolve
-   SNESGetConvergedReason
 
  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
+ basic_solution%converged = reason > 0
- basicPETSC_solution%iterationsNeeded = totalIter
+ basic_solution%iterationsNeeded = totalIter
- basicPETSc_solution%termIll = terminallyIll
+ 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
+end subroutine Basic_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 module spectral_mech_basic

src/spectral_mech_Polarisation.f90

@@ -5,6 +5,10 @@
 !> @brief Polarisation scheme solver
 !--------------------------------------------------------------------------------------------------
 module spectral_mech_Polarisation
+#include <petsc/finclude/petscsnes.h>
+#include <petsc/finclude/petscdmda.h>
+ use PETScdmda
+ use PETScsnes
  use prec, only: & 
    pInt, &
    pReal
@@ -16,7 +20,6 @@ module spectral_mech_Polarisation
 
  implicit none
  private
-#include <petsc/finclude/petsc.h90>
 
  character (len=*), parameter, public :: &
    DAMASK_spectral_solverPolarisation_label = 'polarisation'
@@ -70,13 +73,9 @@ module spectral_mech_Polarisation
  public :: &
    Polarisation_init, &
    Polarisation_solution, &
-   Polarisation_forward, &
+   Polarisation_forward
-   Polarisation_destroy
  external :: &
-   PETScFinalize, &
+   PETScErrorF                                                                                      ! is called in the CHKERRQ macro
-   MPI_Abort, &
-   MPI_Bcast, &
-   MPI_Allreduce
 
 contains
 
@@ -125,28 +124,21 @@ subroutine Polarisation_init
 
  PetscErrorCode :: ierr
  PetscScalar, pointer, dimension(:,:,:,:) :: &
-   FandF_tau, &                                                                                                    ! overall pointer to solution data
+   FandF_tau, &                                                                                     ! overall pointer to solution data
-   F, &                                                                                                         ! specific (sub)pointer
+   F, &                                                                                             ! specific (sub)pointer
-   F_tau                                                                                                     ! specific (sub)pointer
+   F_tau                                                                                            ! specific (sub)pointer
-
+ PetscInt, dimension(:), allocatable :: localK 
- integer(pInt), 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 DMsetFromOptions(da,ierr); CHKERRQ(ierr)
- call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_OBJECT,ierr)   ! residual vector of same shape as solution vector
+ 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, &
+   SNESSolve
-   SNESGetConvergedReason
 
  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

src/spectral_thermal.f90

@@ -4,6 +4,10 @@
 !> @brief Spectral solver for thermal conduction
 !--------------------------------------------------------------------------------------------------
 module spectral_thermal
+#include <petsc/finclude/petscsnes.h>
+#include <petsc/finclude/petscdmda.h>
+ use PETScdmda
+ use PETScsnes
  use prec, only: & 
    pInt, &
    pReal
@@ -18,7 +22,6 @@ module spectral_thermal
 
  implicit none
  private
-#include <petsc/finclude/petsc.h90>
 
  character (len=*), parameter, public :: &
    spectral_thermal_label = 'spectralthermal'
@@ -46,13 +49,9 @@ module spectral_thermal
  public :: &
    spectral_thermal_init, &
    spectral_thermal_solution, &
-   spectral_thermal_forward, &
+   spectral_thermal_forward
-   spectral_thermal_destroy
  external :: &
-   PETScFinalize, &
+   PETScErrorF                                                                                      ! is called in the CHKERRQ macro
-   MPI_Abort, &
-   MPI_Bcast, &
-   MPI_Allreduce
 
 contains
 
@@ -92,22 +91,15 @@ subroutine spectral_thermal_init
  PetscErrorCode :: ierr
 
  external :: &
-   SNESCreate, &
+   SNESsetOptionsPrefix, &
-   SNESSetOptionsPrefix, &
+   DMDAgetCorners, &
-   DMDACreate3D, &
+   DMDASNESsetFunctionLocal
-   SNESSetDM, &
-   DMDAGetCorners, &
-   DMCreateGlobalVector, &
-   DMDASNESSetFunctionLocal, &
-   SNESSetFromOptions
    
- mainProcess: if (worldrank == 0_pInt) then
+ write(6,'(/,a)') ' <<<+-  spectral_thermal init  -+>>>'
-   write(6,'(/,a)') ' <<<+-  spectral_thermal init  -+>>>'
+ write(6,'(/,a)') ' Shanthraj et al., Handbook of Mechanics of Materials, volume in press,'
-   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()
-   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)
+        1, 0, &                                                                                     !< #dof (thermal phase field), ghost boundary width (domain overlap)
-        grid (1),grid(2),localK, &                                                                  ! local grid
+        [grid(1)],[grid(2)],localK, &                                                               !< local grid
-        thermal_grid,ierr)                                                                          ! handle, error
+        thermal_grid,ierr)                                                                          !< handle, error
  CHKERRQ(ierr)
  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, &
+   SNESSolve
-   SNESGetConvergedReason
 
  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)
+ call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr) 
- if (worldrank == 0) then 
+ if (spectral_thermal_solution%converged) &
-   if (spectral_thermal_solution%converged) &
+   write(6,'(/,a)') ' ... thermal conduction converged ..................................'
-     write(6,'(/,a)') ' ... thermal conduction converged ..................................'
+ write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',&
-   write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',&
                                                        minTemperature, maxTemperature, stagNorm
-   write(6,'(/,a)') ' ==========================================================================='
+ write(6,'(/,a)') ' ==========================================================================='
-   flush(6) 
+ flush(6) 
- endif 
 
 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
+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 module spectral_thermal

src/spectral_utilities.f90

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

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
 

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, &
+   temperatureRate
-   material_partHomogenization
 
  implicit none
  integer(pInt), intent(in) :: fileUnit

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

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) :: &

src/vacancyflux_cahnhilliard.f90

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

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

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) :: &