Merge branch 'development' into New-Damage

.gitignore

@@ -1,6 +1,7 @@
 *.pyc
 *.mod
 *.o
+*.hdf5
 *.exe
 *.bak
 *~

.gitlab-ci.yml

@@ -158,12 +158,12 @@ Post_AverageDown:
     - master
     - release
 
-#Post_General:
+Post_General:
-#  stage: postprocessing
+  stage: postprocessing
-#  script: PostProcessing/test.py
+  script: PostProcessing/test.py
-#  except:
+  except:
-#    - master
+    - master
-#    - release
+    - release
 
 Post_GeometryReconstruction:
   stage: postprocessing
@@ -343,6 +343,15 @@ Spectral_MPI:
     - master
     - release
 
+SpectralAll_restartMPI:
+  stage: spectral
+  script:
+    - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel
+    - SpectralAll_restartMPI/test.py
+  except:
+    - master
+    - release
+
 Plasticity_DetectChanges:
   stage: spectral
   script: Plasticity_DetectChanges/test.py
@@ -364,12 +373,12 @@ Phenopowerlaw_singleSlip:
     - master
     - release
 
-#TextureComponents:
+TextureComponents:
-#  stage: spectral
+  stage: spectral
-#  script: TextureComponents/test.py
+  script: TextureComponents/test.py
-#  except:
+  except:
-#    - master
+    - master
-#    - release
+    - release
 
 
 ###################################################################################################
@@ -468,27 +477,24 @@ AbaqusStd:
   script:
     - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen
     - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT abaqus
-  except:
+  only:
-    - master
+    - development
-    - release
 
 Marc:
   stage: createDocumentation
   script:
     - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen
     - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT marc
-  except:
+  only:
-    - master
+    - development
-    - release
 
 Spectral:
   stage: createDocumentation
   script:
     - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel $Doxygen
     - $DAMASKROOT/PRIVATE/documenting/runDoxygen.sh $DAMASKROOT spectral
-  except:
+  only:
-    - master
+    - development
-    - release
 
 ##################################################################################################
 backupData:

CMakeLists.txt

@@ -445,6 +445,33 @@ 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)
+
+
+###################################################################################################
+# PGI Compiler
+###################################################################################################
+elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI")
+
+  if (OPTIMIZATION STREQUAL "OFF")
+    set (OPTIMIZATION_FLAGS "-O0"       )
+  elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
+    set (OPTIMIZATION_FLAGS "-O2")
+  elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
+    set (OPTIMIZATION_FLAGS "-O3")
+  endif ()
+
+
+#------------------------------------------------------------------------------------------------
+# Fine tuning compilation options
+  set (COMPILE_FLAGS "${COMPILE_FLAGS} -Mpreprocess")
+  # preprocessor
+
+  set (STANDARD_CHECK "-Mallocatable=03")
+
+#------------------------------------------------------------------------------------------------
+# Runtime debugging
+  set (DEBUG_FLAGS "${DEBUG_FLAGS} -g")
+  # Includes debugging information in the object module; sets the optimization level to zero unless a -⁠O option is present on the command line
 else ()
   message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized")
 endif ()

LICENSE

@@ -1,4 +1,4 @@
-Copyright 2011-18 Max-Planck-Institut für Eisenforschung GmbH
+Copyright 2011-19 Max-Planck-Institut für Eisenforschung GmbH
 
 DAMASK is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by

Makefile

@@ -7,11 +7,11 @@ all: spectral FEM processing
 
 .PHONY: spectral
 spectral: build/spectral
-	@(cd build/spectral;make --no-print-directory -ws all install;)
+	@(cd build/spectral;make -j4 --no-print-directory -ws all install;)
 
 .PHONY: FEM
 FEM: build/FEM
-	@(cd build/FEM; make --no-print-directory -ws all install;)
+	@(cd build/FEM; make -j4 --no-print-directory -ws all install;)
 
 .PHONY: build/spectral
 build/spectral:

PRIVATE

@@ -1 +1 @@
-Subproject commit b9a52a85cd65cc27a8e863302bd984abdcad1455
+Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b

VERSION

@@ -1 +1 @@
-v2.0.2-1236-g1ef82e35
+v2.0.2-1689-g1a471bcd

env/DAMASK.csh

@@ -64,7 +64,7 @@ endif
 
 setenv DAMASK_NUM_THREADS $DAMASK_NUM_THREADS
 if ( ! $?PYTHONPATH ) then
-  setenv PYTHONPATH $DAMASK_ROOT/lib
+  setenv PYTHONPATH $DAMASK_ROOT/python
 else
-  setenv PYTHONPATH $DAMASK_ROOT/lib:$PYTHONPATH
+  setenv PYTHONPATH $DAMASK_ROOT/python:$PYTHONPATH
 endif

env/DAMASK.sh

@@ -95,7 +95,7 @@ if [ ! -z "$PS1" ]; then
 fi
 
 export DAMASK_NUM_THREADS
-export PYTHONPATH=$DAMASK_ROOT/lib:$PYTHONPATH
+export PYTHONPATH=$DAMASK_ROOT/python:$PYTHONPATH
 
 for var in BASE STAT SOLVER PROCESSING FREE DAMASK_BIN BRANCH; do
   unset "${var}"

env/DAMASK.zsh

@@ -88,7 +88,7 @@ if [ ! -z "$PS1" ]; then
 fi
 
 export DAMASK_NUM_THREADS
-export PYTHONPATH=$DAMASK_ROOT/lib:$PYTHONPATH
+export PYTHONPATH=$DAMASK_ROOT/python:$PYTHONPATH
 
 for var in BASE STAT SOLVER PROCESSING FREE DAMASK_BIN BRANCH; do
   unset "${var}"

examples/ConfigFiles/Homogenization_None_Dummy.config

@@ -1,3 +1,3 @@
 [directSX]
-type	none
+mech	none
 

examples/ConfigFiles/Phase_Isotropic_AluminumIsotropic.config

@@ -11,11 +11,11 @@ lattice_structure isotropic
 
 c11		110.9e9
 c12		58.34e9
-taylorfactor	3
+m		3
 tau0		31e6
 gdot0		0.001
 n		20
 h0		75e6
 tausat		63e6
-w0		2.25
+a		2.25
 atol_resistance	1

installation/mods_Abaqus/abaqus_v6.env

@@ -12,9 +12,17 @@
 #
 import os, re, glob, driverUtils
 from damask import version as DAMASKVERSION
+from damask import Environment
+myEnv = Environment()
 
-# Use the version in $PATH
+if myEnv.options['DAMASK_HDF5'] == 'ON':
-fortCmd = "ifort"
+  # use hdf5 compiler wrapper in $PATH
+  fortCmd   = os.popen('h5fc -shlib -show').read().replace('\n','')                                 # complicated way needed to pass in DAMASKVERSION string
+  link_sl  += fortCmd.split()[1:]
+  fortCmd  +=" -DDAMASKHDF5"
+else:
+  # Use the version in $PATH
+  fortCmd = "ifort"
 
 # -free                           to use free-format FORTRAN 90 syntax
 # -O <0-3>                        optimization level
@@ -50,4 +58,6 @@ ask_delete=OFF
 
 # Remove the temporary names from the namespace
 del fortCmd
+del Environment
+del myEnv
 del DAMASKVERSION

installation/mods_Abaqus/abaqus_v6_debug.env

@@ -12,9 +12,17 @@
 #
 import os, re, glob, driverUtils
 from damask import version as DAMASKVERSION
+from damask import Environment
+myEnv = Environment()
 
-# Use the version in $PATH
+if myEnv.options['DAMASK_HDF5'] == 'ON':
-fortCmd = "ifort"
+  # use hdf5 compiler wrapper in $PATH
+  fortCmd   = os.popen('h5fc -shlib -show').read().replace('\n','')                                 # complicated way needed to pass in DAMASKVERSION string
+  link_sl  += fortCmd.split()[1:]
+  fortCmd  +=" -DDAMASKHDF5"
+else:
+  # Use the version in $PATH
+  fortCmd = "ifort"
 
 # -free                           to use free-format FORTRAN 90 syntax
 # -O <0-3>                        optimization level
@@ -55,4 +63,6 @@ ask_delete=OFF
 
 # Remove the temporary names from the namespace
 del fortCmd
+del Environment
+del myEnv
 del DAMASKVERSION

installation/mods_MarcMentat/2018.1/Marc_tools/include_linux64

@@ -63,7 +63,6 @@ else
  INTEGER_PATH=/$MARC_INTEGER_SIZE
 fi
 
-FCOMP=ifort
 INTELPATH="/opt/intel/compilers_and_libraries_2017/linux"
 
 # find the root directory of the compiler installation:
@@ -99,6 +98,16 @@ else
  FCOMPROOT=
 fi
 
+# DAMASK uses the HDF5 compiler wrapper around the Intel compiler
+if test "$DAMASK_HDF5" = "ON";then
+  H5FC="$(h5fc -shlib -show)"
+  HDF5_LIB=${H5FC//ifort/}
+  FCOMP="$H5FC -DDAMASKHDF5"
+  echo $FCOMP
+else
+  FCOMP=ifort
+fi
+
 # AEM
 if test "$MARCDLLOUTDIR" = ""; then
  DLLOUTDIR="$MARC_LIB"
@@ -535,23 +544,17 @@ else
   DAMASKVERSION="'N/A'"
 fi
 
-if test "$DAMASK_HDF5" = "ON";then
-  DFCOMP="$(h5fc -show) -DDAMASKHDF5"
-else
-  DFCOMP=$FCOMP
-fi
 
-#
 # DAMASK compiler calls: additional flags are in line 2 OpenMP flags in line 3
-DFORTLOWMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -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=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
  -qopenmp -qopenmp-threadprivate=compat\
   $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
-DFORTRANMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -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=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
  -qopenmp -qopenmp-threadprivate=compat\
   $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
-DFORTHIGHMP="$DFCOMP -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 \
+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=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
  -qopenmp -qopenmp-threadprivate=compat\
   $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
@@ -570,15 +573,15 @@ then
 fi
 
       # DAMASK compiler calls: additional flags are in line 2 OpenMP flags in line 3
-  DFORTLOWMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -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=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
    -qopenmp -qopenmp-threadprivate=compat\
     $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
-  DFORTRANMP="$DFCOMP -c -implicitnone -stand f08 -standard-semantics -assume nostd_mod_proc_name -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=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
    -qopenmp -qopenmp-threadprivate=compat\
     $MUMPS_INCLUDE $I8DEFINES  -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
-  DFORTHIGHMP="$DFCOMP -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 \
+  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=2018.1 -DDAMASKVERSION=$DAMASKVERSION \
    -qopenmp -qopenmp-threadprivate=compat\
     $MUMPS_INCLUDE $I8DEFINES -DLinux -DLINUX -DLinux_intel $FDEFINES $DDM $SOLVERFLAGS -I$KDTREE2_MOD"
@@ -744,7 +747,7 @@ SECLIBS="-L$MARC_LIB -llapi"
 
 SOLVERLIBS="${BCSSOLVERLIBS} ${VKISOLVERLIBS} ${CASISOLVERLIBS} ${MF2SOLVERLIBS} \
   $MKLLIB -L$MARC_MKL -liomp5 \
-  $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/kdtree2.a "
+  $MARC_LIB/blas_src.a ${ACSI_LIB}/ACSI_MarcLib.a $KDTREE2_LIB/kdtree2.a $HDF5_LIB "
 
 SOLVERLIBS_DLL=${SOLVERLIBS}
 if test "$AEM_DLL" -eq 1

processing/post/addEuclideanDistance.py

@@ -149,7 +149,6 @@ for name in filenames:
 
   errors  = []
   remarks = []
-  column = {}
   
   if not 3 >= table.label_dimension(options.pos) >= 1:
     errors.append('coordinates "{}" need to have one, two, or three dimensions.'.format(options.pos))

processing/post/addMises.py

@@ -4,6 +4,7 @@
 import os,sys,math
 import numpy as np
 from optparse import OptionParser
+from collections import OrderedDict
 import damask
 
 scriptName = os.path.splitext(os.path.basename(__file__))[0]
@@ -63,10 +64,10 @@ for name in filenames:
 
 # ------------------------------------------ sanity checks ----------------------------------------
 
-  items = {
+  items = OrderedDict([
-            'strain': {'dim': 9, 'shape': [3,3], 'labels':options.strain, 'active':[], 'column': []},
+            ('strain', {'dim': 9, 'shape': [3,3], 'labels':options.strain, 'active':[], 'column': []}),
-            'stress': {'dim': 9, 'shape': [3,3], 'labels':options.stress, 'active':[], 'column': []},
+            ('stress', {'dim': 9, 'shape': [3,3], 'labels':options.stress, 'active':[], 'column': []})
-          }
+          ])
   errors  = []
   remarks = []
   

processing/post/ascii2hdf5.py

@@ -1,142 +0,0 @@
-#!/usr/bin/env python2.7
-# -*- coding: UTF-8 no BOM -*-
-
-# ------------------------------------------------------------------- #
-# NOTE:                                                               #
-#   1. Not all output is defined in the DS_HDF5.xml, please add new   #
-#      new one to the system wide definition file                     #
-#             <DAMASK_ROOT>/lib/damask/DS_HDF5.xml                    #
-#      or specify your own when initializing HDF5 class               #
-#   2. Somehow the point cloud structure cannot be properly handled   #
-#      by Xdmf, which is a descriptive wrapper for visualizing HDF5   #
-#      using Paraview. The current solution is using cell structured  #
-#      HDF5 so that Xdmf can describe the data shape as a rectangular #
-#      mesh rather than polyvertex.                                   #
-# TODO:                                                               #
-#   1. remove the <ASCII_TABLE>._tmp file, basically need a way to    #
-#      just load data from ASCII table.                               #
-#   2. a progress monitor when transferring data from ASCII table     #
-#      to HDF5.                                                       #
-#   3. a more flexible way handle the data structure rather than a    #
-#      xml file.                                                      #
-# ------------------------------------------------------------------- #
-
-import os
-import damask
-import numpy as np
-from optparse import OptionParser
-
-
-scriptName = os.path.splitext(os.path.basename(__file__))[0]
-scriptID = ' '.join([scriptName, damask.version])
-
-
-# ----- helper function ----- #
-def get_rectMshVectors(xyz_array, posNum):
-        """Get Vx, Vy, Vz for rectLinear grid"""
-        # need some improvement, and only works for rectangular grid
-        v = sorted(list(set(xyz_array[:, posNum])))
-        v_interval = (v[2]+v[1])/2.0 - (v[1]+v[0])/2.0
-        v_start = (v[1]+v[0])/2.0 - v_interval
-        v_end = (v[-1]+v[-2])/2.0 + v_interval
-        V = np.linspace(v_start, v_end, len(v)+1)
-        return V
-
-
-# ----- MAIN ---- #
-desp_msg = "Convert DAMASK ascii table to HDF5 file"
-parser = OptionParser(option_class=damask.extendableOption,
-                      usage='%prog options [file[s]]',
-                      description=desp_msg,
-                      version=scriptID)
-parser.add_option('-D', '--DefinitionFile',
-                  dest='storage definition file',
-                  type='string',
-                  metavar='string',
-                  help='definition file for H5 data storage')
-parser.add_option('-p', '--pos', '--position',
-                  dest='pos',
-                  type='string', metavar='string',
-                  help='label of coordinates [%default]')
-
-parser.set_defaults(DefinitionFile='default',
-                    pos='pos')
-
-(options, filenames) = parser.parse_args()
-
-filename = filenames[0]
-
-if options.DefinitionFile == 'default':
-        defFile = None
-else:
-        defFile = options.DefinitionFile
-
-# ----- read in data using DAMASK ASCII table class ----- #
-asciiTable = damask.ASCIItable(name=filename, buffered=False)
-asciiTable.head_read()
-asciiTable.data_readArray()
-incNum = int(asciiTable.data[asciiTable.label_index('inc'), 0])
-fullTable = np.copy(asciiTable.data)  # deep copy all data, just to be safe
-labels = asciiTable.labels()
-labels_idx = [asciiTable.label_index(label) for label in labels]
-featuresDim = [labels_idx[i+1] - labels_idx[i] for i in range(len(labels)-1)]
-featuresDim.append(fullTable.shape[1] - labels_idx[-1])
-
-# ----- figure out size and grid ----- #
-pos_idx = asciiTable.label_index('pos')
-xyz_array = asciiTable.data[:, pos_idx:pos_idx+3]
-Vx = get_rectMshVectors(xyz_array, 0)
-Vy = get_rectMshVectors(xyz_array, 1)
-Vz = get_rectMshVectors(xyz_array, 2)
-# use the dimension of the rectangular grid to reshape all other data
-mshGridDim = [len(Vx)-1, len(Vy)-1, len(Vz)-1]
-
-# ----- compose cmd log ----- #
-cmd_log = " ".join([scriptID, filename])
-
-# ----- create a new HDF5 file and save the data -----#
-# force remove existing HDF5 file
-h5fName = filename.replace(".txt", ".h5")
-try:
-        os.remove(h5fName)
-except OSError:
-        pass
-h5f = damask.H5Table(h5fName,
-                     new_file=True,
-                     dsXMLFile=defFile)
-# adding increment number as root level attributes
-h5f.add_attr('inc', incNum)
-# add the mesh grid data now
-h5f.add_data("Vx", Vx, cmd_log=cmd_log)
-h5f.add_data("Vy", Vy, cmd_log=cmd_log)
-h5f.add_data("Vz", Vz, cmd_log=cmd_log)
-
-# add the rest of data from table
-labelsProcessed = ['inc']
-for fi in range(len(labels)):
-        featureName = labels[fi]
-        # remove trouble maker "("" and ")" from label/feature name
-        if "(" in featureName:
-            featureName = featureName.replace("(", "")
-        if ")" in featureName:
-            featureName = featureName.replace(")", "")
-        # skip increment and duplicated columns in the ASCII table
-        if featureName in labelsProcessed:
-            continue
-
-        featureIdx = labels_idx[fi]
-        featureDim = featuresDim[fi]
-        # grab the data hook
-        dataset = fullTable[:, featureIdx:featureIdx+featureDim]
-        # mapping 2D data onto a 3D rectangular mesh to get 4D data
-        # WARNING: In paraview, the data for a recmesh is mapped as:
-        # -->  len(z), len(y), len(x), size(data)
-        # dataset = dataset.reshape((mshGridDim[0],
-        #                            mshGridDim[1],
-        #                            mshGridDim[2],
-        #                            dataset.shape[1]))
-        # write out data
-        print("adding {}...".format(featureName))
-        h5f.add_data(featureName, dataset, cmd_log=cmd_log)
-        # write down the processed label
-        labelsProcessed.append(featureName)

processing/post/groupTable.py

@@ -1,4 +1,4 @@
-#!/usr/bin/env python2.7
+#!/usr/bin/env python3
 # -*- coding: UTF-8 no BOM -*-
 
 import os,sys
@@ -21,18 +21,19 @@ scriptID   = ' '.join([scriptName,damask.version])
 # --------------------------------------------------------------------
 
 parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
-Apply a user-specified function to condense all rows for which column 'label' has identical values into a single row.
+Apply a user-specified function to condense into a single row all those rows for which columns 'label' have identical values.
-Output table will contain as many rows as there are different (unique) values in the grouping column.
+Output table will contain as many rows as there are different (unique) values in the grouping column(s).
 Periodic domain averaging of coordinate values is supported.
 
 Examples:
 For grain averaged values, replace all rows of particular 'texture' with a single row containing their average.
-""", version = scriptID)
+{name} --label texture --function np.average data.txt
+""".format(name = scriptName), version = scriptID)
 
 parser.add_option('-l','--label',
                   dest = 'label',
-                  type = 'string', metavar = 'string',
+                  action = 'extend', metavar = '<string LIST>',
-                  help = 'column label for grouping rows')
+                  help = 'column label(s) for grouping rows')
 parser.add_option('-f','--function',
                   dest = 'function',
                   type = 'string', metavar = 'string',
@@ -40,7 +41,7 @@ parser.add_option('-f','--function',
 parser.add_option('-a','--all',
                   dest = 'all',
                   action = 'store_true',
-                  help = 'apply mapping function also to grouping column')
+                  help = 'apply mapping function also to grouping column(s)')
                   
 group = OptionGroup(parser, "periodic averaging", "")
 
@@ -57,6 +58,7 @@ parser.add_option_group(group)
 
 parser.set_defaults(function = 'np.average',
                     all      = False,
+                    label    = [],
                     boundary = [0.0, 1.0])
 
 (options,filenames) = parser.parse_args()
@@ -71,7 +73,7 @@ try:
 except:
   mapFunction = None
 
-if options.label is None:
+if options.label is []:
   parser.error('no grouping column specified.')
 if not hasattr(mapFunction,'__call__'):
   parser.error('function "{}" is not callable.'.format(options.function))
@@ -89,13 +91,20 @@ for name in filenames:
 
 # ------------------------------------------ sanity checks ---------------------------------------  
 
+  remarks = []
+  errors = []
+
   table.head_read()
-  if table.label_dimension(options.label) != 1:
+  grpColumns = table.label_index(options.label)[::-1]
-    damask.util.croak('column {} is not of scalar dimension.'.format(options.label))
+  grpColumns = grpColumns[np.where(grpColumns>=0)]
-    table.close(dismiss = True)                                                                     # close ASCIItable and remove empty file
+
+  if len(grpColumns) == 0:  errors.append('no valid grouping column present.')
+
+  if remarks != []: damask.util.croak(remarks)
+  if errors != []:
+    damask.util.croak(errors)
+    table.close(dismiss=True)
     continue
-  else:
-    grpColumn = table.label_index(options.label)
 
 # ------------------------------------------ assemble info ---------------------------------------  
 
@@ -108,10 +117,9 @@ for name in filenames:
   indexrange = table.label_indexrange(options.periodic) if options.periodic is not None else []
   rows,cols  = table.data.shape
 
-  table.data = table.data[np.lexsort([table.data[:,grpColumn]])]                                    # sort data by grpColumn
+  table.data = table.data[np.lexsort(table.data[:,grpColumns].T)]                                   # sort data by grpColumn(s)
-  
+  values,index = np.unique(table.data[:,grpColumns], axis=0, return_index=True)                     # unique grpColumn values and their positions
-  values,index = np.unique(table.data[:,grpColumn], return_index = True)                            # unique grpColumn values and their positions
+  index = sorted(np.append(index,rows))                                                             # add termination position
-  index = np.append(index,rows)                                                                     # add termination position
   grpTable = np.empty((len(values), cols))                                                          # initialize output
   
   for i in range(len(values)):                                                                      # iterate over groups (unique values in grpColumn)
@@ -119,7 +127,7 @@ for name in filenames:
     grpTable[i,indexrange] = \
       periodicAverage(table.data[index[i]:index[i+1],indexrange],options.boundary)                  # apply periodicAverage mapping function
 
-    if not options.all: grpTable[i,grpColumn] = table.data[index[i],grpColumn]                      # restore grouping column value
+    if not options.all: grpTable[i,grpColumns] = table.data[index[i],grpColumns]                    # restore grouping column value
   
   table.data = grpTable
 

processing/post/postResults.py

@@ -831,7 +831,7 @@ if options.info:
 elementsOfNode = {}
 Nelems = stat['NumberOfElements']
 for e in range(Nelems):
-  if options.verbose and Nelems > 100 and e%(Nelems//100) == 0:                                     # report in 1% steps if possible and avoid modulo by zero
+  if options.verbose and Nelems >= 50 and e%(Nelems//50) == 0:                                      # report in 2% steps if possible and avoid modulo by zero
     damask.util.progressBar(iteration=e,total=Nelems,prefix='1/3: connecting elements')
   for n in map(p.node_sequence,p.element(e).items):
     if n not in elementsOfNode:
@@ -856,7 +856,7 @@ damask.util.progressBar(iteration=1,total=1,prefix='1/3: connecting elements')
 if options.nodalScalar:
   Npoints = stat['NumberOfNodes']
   for n in range(Npoints):
-    if options.verbose and Npoints > 100 and e%(Npoints//100) == 0:                                 # report in 1% steps if possible and avoid modulo by zero
+    if options.verbose and Npoints >= 50 and e%(Npoints//50) == 0:                                  # report in 2% steps if possible and avoid modulo by zero
       damask.util.progressBar(iteration=n,total=Npoints,prefix='2/3: scanning nodes     ')
     myNodeID = p.node_id(n)
     myNodeCoordinates = [p.node(n).x, p.node(n).y, p.node(n).z]
@@ -893,7 +893,7 @@ if options.nodalScalar:
 else:
   Nelems = stat['NumberOfElements']
   for e in range(Nelems):
-    if options.verbose and Nelems > 100 and e%(Nelems//100) == 0:                                   # report in 1% steps if possible and avoid modulo by zero
+    if options.verbose and Nelems >= 50 and e%(Nelems//50) == 0:                                    # report in 2% steps if possible and avoid modulo by zero
       damask.util.progressBar(iteration=e,total=Nelems,prefix='2/3: scanning elements  ')
     myElemID = p.element_id(e)
     myIpCoordinates = ipCoords(p.element(e).type, list(map(lambda node: [node.x, node.y, node.z],
@@ -1034,7 +1034,7 @@ for incCount,position in enumerate(locations):     # walk through locations
   Ngroups = len(groups)
   for j,group in enumerate(groups):
     f = incCount*Ngroups + j
-    if options.verbose and (Ngroups*Nincs) > 100 and f%((Ngroups*Nincs)//100) == 0:                 # report in 1% steps if possible and avoid modulo by zero
+    if options.verbose and (Ngroups*Nincs) >= 50 and f%((Ngroups*Nincs)//50) == 0:                  # report in 2% steps if possible and avoid modulo by zero
       damask.util.progressBar(iteration=f,total=Ngroups*Nincs,prefix='3/3: processing points  ')
     N = 0                                                                                           # group member counter
     for (e,n,i,g,n_local) in group[1:]:                                                             # loop over group members
@@ -1087,7 +1087,7 @@ for incCount,position in enumerate(locations):     # walk through locations
                                       ['Crystallite']*len(options.crystalliteResult) +
                                       ['Constitutive']*len(options.constitutiveResult)
                                       ):
-          outputIndex = (list(zip(*outputFormat[resultType]['outputs']))[0]).index(label)             # find the position of this output in the outputFormat
+          outputIndex = (list(zip(*outputFormat[resultType]['outputs']))[0]).index(label)           # find the position of this output in the outputFormat
           length = int(outputFormat[resultType]['outputs'][outputIndex][1])
           thisHead = heading('_',[[component,''.join( label.split() )] for component in range(int(length>1),length+int(length>1))])
           if assembleHeader: header += thisHead

processing/post/viewTable.py

@@ -61,7 +61,14 @@ for name in filenames:
     table = damask.ASCIItable(name = name,
                               buffered = False, labeled = options.labeled, readonly = True)
   except: continue
-  damask.util.report(scriptName,name)
+  details = ', '.join(
+                      (['header'] if options.table                  else []) +
+                      (['info']   if options.head or options.info   else []) +
+                      (['labels'] if options.head or options.labels else []) +
+                      (['data']   if options.data                   else []) +
+                      []
+                     )
+  damask.util.report(scriptName,(name if name is not None else '') + ('' if details == '' else ' -- '+details))
 
 # ------------------------------------------ output head ---------------------------------------  
 

processing/pre/geom_fromVPSC.py

@@ -1,185 +0,0 @@
-#!/usr/bin/env python2.7
-# -*- coding: UTF-8 no BOM -*-
-
-import os,sys,math
-import numpy as np
-from optparse import OptionParser
-import damask
-
-scriptName = os.path.splitext(os.path.basename(__file__))[0]
-scriptID   = ' '.join([scriptName,damask.version])
-
-#--------------------------------------------------------------------------------------------------
-#                                MAIN
-#--------------------------------------------------------------------------------------------------
-parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """
-Generate geometry description and material configuration from input files used by R.A. Lebensohn.
-
-""", version = scriptID)
-
-parser.add_option('--column',          dest='column', type='int', metavar = 'int',
-                  help='data column to discriminate between both phases [%default]')
-parser.add_option('-t','--threshold',      dest='threshold', type='float', metavar = 'float',
-                  help='threshold value for phase discrimination [%default]')
-parser.add_option('--homogenization', dest='homogenization', type='int', metavar = 'int',
-                  help='homogenization index for <microstructure> configuration [%default]')
-parser.add_option('--phase', dest='phase', type='int', nargs = 2, metavar = 'int int',
-                  help='phase indices for <microstructure> configuration %default')
-parser.add_option('--crystallite', dest='crystallite', type='int', metavar = 'int',
-                  help='crystallite index for <microstructure> configuration [%default]')
-parser.add_option('--compress',            dest='compress', action='store_true',
-                  help='lump identical microstructure and texture information [%default]')
-parser.add_option('-p', '--precision',    dest='precision', choices=['0','1','2','3'], metavar = 'int',
-                  help = 'euler angles decimal places for output format and compressing {0,1,2,3} [2]')
-
-parser.set_defaults(column         = 7)
-parser.set_defaults(threshold      = 1.0)
-parser.set_defaults(homogenization = 1)
-parser.set_defaults(phase          = [1,2])
-parser.set_defaults(crystallite    = 1)
-parser.set_defaults(config         = False)
-parser.set_defaults(compress       = False)
-parser.set_defaults(precision      = '2')
-
-(options,filenames) = parser.parse_args()
-
-if filenames == []: filenames = [None]
-
-for name in filenames:
-  try:
-    table = damask.ASCIItable(name = name,
-                              outname = os.path.splitext(name)[-2]+'.geom' if name else name,
-                              buffered = False,
-                              labeled = False)
-  except: continue
-  damask.util.report(scriptName,name)
-
-  info = {
-          'grid':   np.zeros(3,'i'),
-          'size':   np.zeros(3,'d'),
-          'origin': np.zeros(3,'d'),
-          'microstructures': 0,
-          'homogenization':  options.homogenization
-         }
-         
-  coords = [{},{},{}]
-  pos = {'min':[ float("inf"), float("inf"), float("inf")],
-         'max':[-float("inf"),-float("inf"),-float("inf")]}
-
-  phase =       []
-  eulerangles = []
-  outputAlive = True
-
-# ------------------------------------------ process data ------------------------------------------
-  while outputAlive and table.data_read():
-    if table.data != []:
-      currPos = table.data[3:6]
-      for i in range(3):
-        coords[i][currPos[i]] = True
-      currPos = map(float,currPos)
-      for i in range(3):
-        pos['min'][i] = min(pos['min'][i],currPos[i])
-        pos['max'][i] = max(pos['max'][i],currPos[i])
-      eulerangles.append(map(math.degrees,map(float,table.data[:3])))
-      phase.append(options.phase[int(float(table.data[options.column-1]) > options.threshold)])
-      
-# --------------- determine size and grid ---------------------------------------------------------
-  info['grid'] = np.array(map(len,coords),'i')
-  info['size'] = info['grid']/np.maximum(np.ones(3,'d'),info['grid']-1.0)* \
-                       np.array([pos['max'][0]-pos['min'][0],
-                                 pos['max'][1]-pos['min'][1],
-                                 pos['max'][2]-pos['min'][2]],'d')
-  eulerangles = np.array(eulerangles,dtype='f').reshape(info['grid'].prod(),3)
-  phase       = np.array(phase,dtype='i').reshape(info['grid'].prod())
-
-  limits = [360,180,360]
-  if any([np.any(eulerangles[:,i]>=limits[i]) for i in [0,1,2]]):
-    damask.util.croak.write('Error: euler angles out of bound. Ang file might contain unidexed poins.\n')
-    for i,angle in enumerate(['phi1','PHI','phi2']):
-      for n in np.nditer(np.where(eulerangles[:,i]>=limits[i]),['zerosize_ok']):
-        damask.util.croak.write('%s in line %i (%4.2f %4.2f %4.2f)\n'
-                                     %(angle,n,eulerangles[n,0],eulerangles[n,1],eulerangles[n,2]))
-    continue
-  eulerangles=np.around(eulerangles,int(options.precision))                                         # round to desired precision
-# ensure, that rounded euler angles are not out of bounds (modulo by limits)
-  for i,angle in enumerate(['phi1','PHI','phi2']):
-    eulerangles[:,i]%=limits[i]                                                                     
-
-# scale angles by desired precision and convert to int. create unique integer key from three euler angles by
-# concatenating the string representation with leading zeros and store as integer and search unique euler angle keys.
-# Texture IDs are the indices of the first occurrence, the inverse is used to construct the microstructure
-# create a microstructure (texture/phase pair) for each point using unique texture IDs.
-# Use longInt (64bit, i8) because the keys might be long
-  if options.compress:
-    formatString='{0:0>'+str(int(options.precision)+3)+'}'
-    euleranglesRadInt = (eulerangles*10**int(options.precision)).astype('int')
-    eulerKeys = np.array([int(''.join(map(formatString.format,euleranglesRadInt[i,:]))) \
-                                                             for i in range(info['grid'].prod())])
-    devNull, texture, eulerKeys_idx = np.unique(eulerKeys, return_index = True, return_inverse=True)
-    msFull = np.array([[eulerKeys_idx[i],phase[i]] for i in range(info['grid'].prod())],'i8')
-    devNull,msUnique,matPoints = np.unique(msFull.view('c16'),True,True)
-    matPoints+=1
-    microstructure = np.array([msFull[i] for i in msUnique])                                        # pick only unique microstructures
-  else:
-    texture = np.arange(info['grid'].prod())
-    microstructure = np.hstack( zip(texture,phase) ).reshape(info['grid'].prod(),2)                 # create texture/phase pairs
-  formatOut = 1+int(math.log10(len(texture)))
-
-  config_header = []
-
-  formatwidth = 1+int(math.log10(len(microstructure)))
-  config_header += ['<microstructure>']
-  for i in range(len(microstructure)):
-    config_header += ['[Grain%s]'%str(i+1).zfill(formatwidth),
-                       'crystallite\t%i'%options.crystallite,
-                       '(constituent)\tphase %i\ttexture %i\tfraction 1.0'%(microstructure[i,1],microstructure[i,0]+1)
-                      ]
-  config_header += ['<texture>']
-
-  eulerFormatOut='%%%i.%if'%(int(options.precision)+4,int(options.precision))
-  outStringAngles='(gauss) phi1 '+eulerFormatOut+' Phi '+eulerFormatOut+' phi2 '+eulerFormatOut+' scatter 0.0 fraction 1.0'
-  for i in range(len(texture)):
-    config_header +=    ['[Texture%s]'%str(i+1).zfill(formatOut),
-                          outStringAngles%tuple(eulerangles[texture[i],...])
-                        ]
-
-  table.labels_clear()
-  table.info_clear()
-
-  info['microstructures'] = len(microstructure)
-
-#--- report ---------------------------------------------------------------------------------------
-  damask.util.croak('grid     a b c:  %s\n'%(' x '.join(map(str,info['grid']))) +
-                    'size     x y z:  %s\n'%(' x '.join(map(str,info['size']))) +
-                    'origin   x y z:  %s\n'%(' : '.join(map(str,info['origin']))) +
-                    'homogenization:  %i\n'%info['homogenization'] +
-                    'microstructures: %i\n\n'%info['microstructures'])
-
-  if np.any(info['grid'] < 1):
-    damask.util.croak('invalid grid a b c.\n')
-    continue
-  if np.any(info['size'] <= 0.0):
-    damask.util.croak('invalid size x y z.\n')
-    continue
-
-
-#--- write data -----------------------------------------------------------------------------------
-  table.info_append([' '.join([scriptID] + sys.argv[1:]),
-                     "grid\ta %i\tb %i\tc %i"%(info['grid'][0],info['grid'][1],info['grid'][2],),
-                     "size\tx %f\ty %f\tz %f"%(info['size'][0],info['size'][1],info['size'][2],),
-                     "origin\tx %f\ty %f\tz %f"%(info['origin'][0],info['origin'][1],info['origin'][2],),
-                     "microstructures\t%i"%info['microstructures'],
-                     "homogenization\t%i"%info['homogenization'],
-                     config_header
-                    ])
-  table.head_write()
-  if options.compress:
-    table.data = matPoints.reshape(info['grid'][1]*info['grid'][2],info['grid'][0])
-    table.data_writeArray('%%%ii'%(formatwidth),delimiter=' ')
-  else:
-    table.data = ["1 to %i\n"%(info['microstructures'])]
-  
-# ------------------------------------------ output finalization -----------------------------------  
-
-  table.close()
-

processing/pre/mentat_pbcOnBoxMesh.py

@@ -1,4 +1,4 @@
-#!/usr/bin/env python2.7
+#!/usr/bin/env python3
 # -*- coding: UTF-8 no BOM -*-
 
 import sys,os,re,time,tempfile
@@ -93,7 +93,7 @@ def add_servoLinks(mfd_data,active=[True,True,True]):  # directions on which to
   for i in range(len(mfd_data)):
     mfd_dict[mfd_data[i]['label']] = i
 
-  NodeCoords = np.array(mfd_data[mfd_dict['nodes']]['els'][0::4])[:,1:4]
+  NodeCoords = np.array(mfd_data[mfd_dict['nodes']]['els'][1::4])[:,1:4]
   Nnodes = NodeCoords.shape[0]  
   
   box['min'] = NodeCoords.min(axis=0)                                                               # find the bounding box

processing/pre/mentat_spectralBox.py

@@ -49,7 +49,7 @@ def output(cmds,locals,dest):
 #-------------------------------------------------------------------------------------------------
 def init():
   return [
-    "#"+' '.join([scriptID] + sys.argv[1:]),
+    "|"+' '.join([scriptID] + sys.argv[1:]),
     "*draw_manual",              # prevent redrawing in Mentat, should be much faster
     "*new_model yes",
     "*reset",

python/damask/util.py

@@ -134,7 +134,7 @@ class extendableOption(Option):
 
 # Print iterations progress
 # from https://gist.github.com/aubricus/f91fb55dc6ba5557fbab06119420dd6a
-def progressBar(iteration, total, prefix='', suffix='', decimals=1, bar_length=100):
+def progressBar(iteration, total, prefix='', bar_length=50):
   """
   Call in a loop to create terminal progress bar
 
@@ -142,16 +142,29 @@ def progressBar(iteration, total, prefix='', suffix='', decimals=1, bar_length=1
       iteration   - Required  : current iteration (Int)
       total       - Required  : total iterations (Int)
       prefix      - Optional  : prefix string (Str)
-      suffix      - Optional  : suffix string (Str)
-      decimals    - Optional  : positive number of decimals in percent complete (Int)
       bar_length  - Optional  : character length of bar (Int)
   """
-  str_format = "{0:." + str(decimals) + "f}"
+  fraction = iteration / float(total)
-  percents = str_format.format(100 * (iteration / float(total)))
+  if not hasattr(progressBar, "last_fraction"):                                                     # first call to function
-  filled_length = int(round(bar_length * iteration / float(total)))
+    progressBar.start_time    = time.time()
-  bar = '█' * filled_length + '-' * (bar_length - filled_length)
+    progressBar.last_fraction = -1.0
+    remaining_time = '   n/a'
+  else:
+    if fraction <= progressBar.last_fraction or iteration == 0:                                     # reset: called within a new loop
+      progressBar.start_time    = time.time()
+      progressBar.last_fraction = -1.0
+      remaining_time = '   n/a'
+    else:
+      progressBar.last_fraction = fraction
+      remainder = (total - iteration) * (time.time()-progressBar.start_time)/iteration
+      remaining_time = '{: 3d}:'.format(int( remainder//3600)) + \
+                       '{:02d}:'.format(int((remainder//60)%60)) + \
+                       '{:02d}' .format(int( remainder     %60))
 
-  sys.stderr.write('\r%s |%s| %s%s %s' % (prefix, bar, percents, '%', suffix)),
+  filled_length = int(round(bar_length * fraction))
+  bar = '█' * filled_length + '░' * (bar_length - filled_length)
+
+  sys.stderr.write('\r{} {} {}'.format(prefix, bar, remaining_time)),
 
   if iteration == total: sys.stderr.write('\n\n')
   sys.stderr.flush()

src/CMakeLists.txt

@@ -29,24 +29,28 @@ add_library(IO OBJECT "IO.f90")
 add_dependencies(IO DAMASK_INTERFACE)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:IO>)
 
-add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90")
-add_dependencies(HDF5_UTILITIES IO)
-list(APPEND OBJECTFILES $<TARGET_OBJECTS:HDF5_UTILITIES>)
-
 add_library(NUMERICS OBJECT "numerics.f90")
-add_dependencies(NUMERICS HDF5_UTILITIES)
+add_dependencies(NUMERICS IO)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:NUMERICS>)
 
 add_library(DEBUG OBJECT "debug.f90")
 add_dependencies(DEBUG NUMERICS)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:DEBUG>)
 
-add_library(CONFIG OBJECT "config.f90")
+add_library(DAMASK_CONFIG OBJECT "config.f90")
-add_dependencies(CONFIG DEBUG)
+add_dependencies(DAMASK_CONFIG DEBUG)
-list(APPEND OBJECTFILES $<TARGET_OBJECTS:CONFIG>)
+list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_CONFIG>)
+
+add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90")
+add_dependencies(HDF5_UTILITIES DAMASK_CONFIG)
+list(APPEND OBJECTFILES $<TARGET_OBJECTS:HDF5_UTILITIES>)
+
+add_library(RESULTS OBJECT "results.f90")
+add_dependencies(RESULTS HDF5_UTILITIES)
+list(APPEND OBJECTFILES $<TARGET_OBJECTS:RESULTS>)
 
 add_library(FEsolving OBJECT "FEsolving.f90")
-add_dependencies(FEsolving DEBUG)
+add_dependencies(FEsolving RESULTS)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:FEsolving>)
 
 add_library(DAMASK_MATH OBJECT "math.f90")
@@ -68,7 +72,7 @@ elseif (PROJECT_NAME STREQUAL "DAMASK_FEM")
 endif()
 
 add_library(MATERIAL OBJECT "material.f90")
-add_dependencies(MATERIAL MESH CONFIG)
+add_dependencies(MATERIAL MESH DAMASK_CONFIG)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:MATERIAL>)
 
 add_library(DAMASK_HELPERS OBJECT "lattice.f90")
@@ -90,9 +94,7 @@ list(APPEND OBJECTFILES $<TARGET_OBJECTS:PLASTIC>)
 add_library (KINEMATICS OBJECT
   "kinematics_cleavage_opening.f90"
   "kinematics_slipplane_opening.f90"
-  "kinematics_thermal_expansion.f90"
+  "kinematics_thermal_expansion.f90")
-  "kinematics_vacancy_strain.f90"
-  "kinematics_hydrogen_strain.f90")
 add_dependencies(KINEMATICS DAMASK_HELPERS)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:KINEMATICS>)
 
@@ -102,10 +104,7 @@ add_library (SOURCE OBJECT
   "source_damage_isoBrittle.f90"
   "source_damage_isoDuctile.f90"
   "source_damage_anisoBrittle.f90"
-  "source_damage_anisoDuctile.f90"
+  "source_damage_anisoDuctile.f90")
-  "source_vacancy_phenoplasticity.f90"
-  "source_vacancy_irradiation.f90"
-  "source_vacancy_thermalfluc.f90")
 add_dependencies(SOURCE DAMASK_HELPERS)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:SOURCE>)
 
@@ -124,25 +123,6 @@ add_library(HOMOGENIZATION OBJECT
 add_dependencies(HOMOGENIZATION CRYSTALLITE)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:HOMOGENIZATION>)
 
-add_library(HYDROGENFLUX OBJECT
-  "hydrogenflux_isoconc.f90"
-  "hydrogenflux_cahnhilliard.f90")
-add_dependencies(HYDROGENFLUX CRYSTALLITE)
-list(APPEND OBJECTFILES $<TARGET_OBJECTS:HYDROGENFLUX>)
-
-add_library(POROSITY OBJECT
-  "porosity_none.f90"
-  "porosity_phasefield.f90")
-add_dependencies(POROSITY CRYSTALLITE)
-list(APPEND OBJECTFILES $<TARGET_OBJECTS:POROSITY>)
-
-add_library(VACANCYFLUX OBJECT
-  "vacancyflux_isoconc.f90"
-  "vacancyflux_isochempot.f90"
-  "vacancyflux_cahnhilliard.f90")
-add_dependencies(VACANCYFLUX CRYSTALLITE)
-list(APPEND OBJECTFILES $<TARGET_OBJECTS:VACANCYFLUX>)
-
 add_library(DAMAGE OBJECT
   "damage_none.f90"
   "damage_local.f90"
@@ -158,7 +138,7 @@ add_dependencies(THERMAL CRYSTALLITE)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:THERMAL>)
 
 add_library(DAMASK_ENGINE OBJECT "homogenization.f90")
-add_dependencies(DAMASK_ENGINE THERMAL DAMAGE VACANCYFLUX POROSITY HYDROGENFLUX HOMOGENIZATION)
+add_dependencies(DAMASK_ENGINE THERMAL DAMAGE HOMOGENIZATION)
 list(APPEND OBJECTFILES $<TARGET_OBJECTS:DAMASK_ENGINE>)
 
 add_library(DAMASK_CPFE OBJECT "CPFEM2.f90")

src/CPFEM.f90

@@ -155,7 +155,6 @@ subroutine CPFEM_init
    crystallite_Lp0, &
    crystallite_Fi0, &
    crystallite_Li0, &
-   crystallite_dPdF0, &
    crystallite_Tstar0_v
 
  implicit none
@@ -207,9 +206,6 @@ subroutine CPFEM_init
    read (777,rec=1) crystallite_Li0
    close (777)
 
-   call IO_read_realFile(777,'convergeddPdF'//trim(rankStr),modelName,size(crystallite_dPdF0))
-   read (777,rec=1) crystallite_dPdF0
-   close (777)
 
    call IO_read_realFile(777,'convergedTstar'//trim(rankStr),modelName,size(crystallite_Tstar0_v))
    read (777,rec=1) crystallite_Tstar0_v
@@ -286,12 +282,11 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
    math_identity2nd, &
    math_mul33x33, &
    math_det33, &
-   math_transpose33, &
+   math_delta, &
-   math_I3, &
+   math_sym3333to66, &
-   math_Mandel3333to66, &
+   math_66toSym3333, &
-   math_Mandel66to3333, &
+   math_sym33to6, &
-   math_Mandel33to6, &
+   math_6toSym33
-   math_Mandel6to33
  use mesh, only: &
    mesh_FEasCP, &
    mesh_NcpElems, &
@@ -304,8 +299,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
    homogState, &
    thermalState, &
    damageState, &
-   vacancyfluxState, &
-   hydrogenfluxState, &
    phaseAt, phasememberAt, &
    material_phase, &
    phase_plasticity, &
@@ -328,7 +321,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
    crystallite_Lp, &
    crystallite_Li0, &
    crystallite_Li, &
-   crystallite_dPdF0, &
    crystallite_dPdF, &
    crystallite_Tstar0_v, &
    crystallite_Tstar_v
@@ -355,8 +347,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
  integer(pInt), intent(in) ::                        mode                                           !< computation mode  1: regular computation plus aging of results
  real(pReal), intent(in) ::                          temperature_inp                                !< temperature
  logical, intent(in) ::                              parallelExecution                              !< flag indicating parallel computation of requested IPs
- real(pReal), dimension(6), intent(out) ::           cauchyStress                                   !< stress vector in Mandel notation
+ real(pReal), dimension(6), intent(out) ::           cauchyStress                                   !< stress as 6 vector
- real(pReal), dimension(6,6), intent(out) ::         jacobian                                       !< jacobian in Mandel notation (Consistent tangent dcs/dE)
+ real(pReal), dimension(6,6), intent(out) ::         jacobian                                       !< jacobian as 66 tensor (Consistent tangent dcs/dE)
 
  real(pReal)                                         J_inverse, &                                   ! inverse of Jacobian
                                                      rnd
@@ -400,7 +392,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
    crystallite_Lp0 = crystallite_Lp                                                            ! crystallite plastic velocity
    crystallite_Fi0 = crystallite_Fi                                                            ! crystallite intermediate deformation
    crystallite_Li0 = crystallite_Li                                                            ! crystallite intermediate velocity
-   crystallite_dPdF0 = crystallite_dPdF                                                        ! crystallite stiffness
    crystallite_Tstar0_v = crystallite_Tstar_v                                                  ! crystallite 2nd Piola Kirchhoff stress
 
    forall ( i = 1:size(plasticState    )) plasticState(i)%state0     = plasticState(i)%state   ! copy state in this lenghty way because: A component cannot be an array if the encompassing structure is an array
@@ -421,8 +412,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
      homogState       (homog)%state0 =  homogState       (homog)%state
      thermalState     (homog)%state0 =  thermalState     (homog)%state
      damageState      (homog)%state0 =  damageState      (homog)%state
-     vacancyfluxState (homog)%state0 =  vacancyfluxState (homog)%state
-     hydrogenfluxState(homog)%state0 =  hydrogenfluxState(homog)%state
    enddo
   
 
@@ -458,10 +447,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
      write (777,rec=1) crystallite_Li0
      close (777)
 
-     call IO_write_jobRealFile(777,'convergeddPdF'//trim(rankStr),size(crystallite_dPdF0))
-     write (777,rec=1) crystallite_dPdF0
-     close (777)
-
      call IO_write_jobRealFile(777,'convergedTstar'//trim(rankStr),size(crystallite_Tstar0_v))
      write (777,rec=1) crystallite_Tstar0_v
      close (777)
@@ -538,8 +523,8 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
        if (iand(debug_level(debug_CPFEM), debug_levelBasic) /=  0_pInt) then
            write(6,'(a,1x,i8,1x,i2)') '<< CPFEM >> OUTDATED at elFE ip',elFE,ip
            write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 old:',&
-                                             math_transpose33(materialpoint_F(1:3,1:3,ip,elCP))
+                                             transpose(materialpoint_F(1:3,1:3,ip,elCP))
-           write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 now:',math_transpose33(ffn1)
+           write(6,'(a,/,3(12x,3(f10.6,1x),/))') '<< CPFEM >> FFN1 now:',transpose(ffn1)
        endif
        outdatedFFN1 = .true.
      endif
@@ -597,26 +582,25 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
        endif
 
        ! translate from P to CS
-       Kirchhoff = math_mul33x33(materialpoint_P(1:3,1:3,ip,elCP), math_transpose33(materialpoint_F(1:3,1:3,ip,elCP)))
+       Kirchhoff = math_mul33x33(materialpoint_P(1:3,1:3,ip,elCP), transpose(materialpoint_F(1:3,1:3,ip,elCP)))
        J_inverse  = 1.0_pReal / math_det33(materialpoint_F(1:3,1:3,ip,elCP))
-       CPFEM_cs(1:6,ip,elCP) = math_Mandel33to6(J_inverse * Kirchhoff)
+       CPFEM_cs(1:6,ip,elCP) = math_sym33to6(J_inverse * Kirchhoff,weighted=.false.)
 
        !  translate from dP/dF to dCS/dE
        H = 0.0_pReal
        do i=1,3; do j=1,3; do k=1,3; do l=1,3; do m=1,3; do n=1,3
-         H(i,j,k,l) = H(i,j,k,l) + &
+         H(i,j,k,l) = H(i,j,k,l) &
-                       materialpoint_F(j,m,ip,elCP) * &
+                    +  materialpoint_F(j,m,ip,elCP) * materialpoint_F(l,n,ip,elCP) &
-                       materialpoint_F(l,n,ip,elCP) * &
+                                                    * materialpoint_dPdF(i,m,k,n,ip,elCP) &
-                       materialpoint_dPdF(i,m,k,n,ip,elCP) - &
+                    -  math_delta(j,l) * materialpoint_F(i,m,ip,elCP) * materialpoint_P(k,m,ip,elCP) &
-                       math_I3(j,l) * materialpoint_F(i,m,ip,elCP) * materialpoint_P(k,m,ip,elCP) + &
+                    +  0.5_pReal * (  Kirchhoff(j,l)*math_delta(i,k) + Kirchhoff(i,k)*math_delta(j,l) &
-                       0.5_pReal * (math_I3(i,k) * Kirchhoff(j,l) + math_I3(j,l) * Kirchhoff(i,k) + &
+                                    + Kirchhoff(j,k)*math_delta(i,l) + Kirchhoff(i,l)*math_delta(j,k))
-                                  math_I3(i,l) * Kirchhoff(j,k) + math_I3(j,k) * Kirchhoff(i,l))
        enddo; enddo; enddo; enddo; enddo; enddo
 
        forall(i=1:3, j=1:3,k=1:3,l=1:3) &
          H_sym(i,j,k,l) = 0.25_pReal * (H(i,j,k,l) + H(j,i,k,l) + H(i,j,l,k) + H(j,i,l,k))
 
-       CPFEM_dcsde(1:6,1:6,ip,elCP) = math_Mandel3333to66(J_inverse * H_sym)
+       CPFEM_dcsde(1:6,1:6,ip,elCP) = math_sym3333to66(J_inverse * H_sym,weighted=.false.)
 
      endif terminalIllness
    endif validCalculation
@@ -643,7 +627,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
 
 
  !*** remember extreme values of stress ...
- cauchyStress33 = math_Mandel6to33(CPFEM_cs(1:6,ip,elCP))
+ cauchyStress33 = math_6toSym33(CPFEM_cs(1:6,ip,elCP),weighted=.false.)
  if (maxval(cauchyStress33) > debug_stressMax) then
    debug_stressMaxLocation = [elCP, ip]
    debug_stressMax = maxval(cauchyStress33)
@@ -653,7 +637,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
    debug_stressMin = minval(cauchyStress33)
  endif
  !*** ... and Jacobian
- jacobian3333 = math_Mandel66to3333(CPFEM_dcsdE(1:6,1:6,ip,elCP))
+ jacobian3333 = math_66toSym3333(CPFEM_dcsdE(1:6,1:6,ip,elCP),weighted=.false.)
  if (maxval(jacobian3333) > debug_jacobianMax) then
    debug_jacobianMaxLocation = [elCP, ip]
    debug_jacobianMax = maxval(jacobian3333)

src/CPFEM2.f90

@@ -10,8 +10,8 @@ module CPFEM2
 
  public :: &
    CPFEM_age, &
-   CPFEM_initAll
+   CPFEM_initAll, &
-
+   CPFEM_results
 contains
 
 
@@ -20,8 +20,7 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_initAll()
  use prec, only: &
-   pInt
+   pInt, &
- use prec, only: &
    prec_init
  use numerics, only: &
    numerics_init
@@ -39,6 +38,8 @@ subroutine CPFEM_initAll()
    material_init
  use HDF5_utilities, only: &
    HDF5_utilities_init
+ use results, only: &
+   results_init
  use lattice, only: &
    lattice_init
  use constitutive, only: &
@@ -73,6 +74,7 @@ subroutine CPFEM_initAll()
  call lattice_init
  call material_init
  call HDF5_utilities_init
+ call results_init
  call constitutive_init
  call crystallite_init
  call homogenization_init
@@ -105,8 +107,7 @@ subroutine CPFEM_init
    debug_levelBasic, &
    debug_levelExtensive
  use FEsolving, only: &
-   restartRead, &
+   restartRead
-   modelName
  use material, only: &
    material_phase, &
    homogState, &
@@ -120,28 +121,26 @@ subroutine CPFEM_init
    crystallite_Lp0, &
    crystallite_Fi0, &
    crystallite_Li0, &
-   crystallite_dPdF0, &
    crystallite_Tstar0_v
  use hdf5
  use HDF5_utilities, only: &
    HDF5_openFile, &
-   HDF5_openGroup2, &
+   HDF5_closeFile, &
+   HDF5_openGroup, &
+   HDF5_closeGroup, &
    HDF5_read
  use DAMASK_interface, only: &
    getSolverJobName
 
  implicit none
- integer(pInt) :: k,l,m,ph,homog
+ integer(pInt) :: ph,homog
  character(len=1024) :: rankStr, PlasticItem, HomogItem
- integer(HID_T) :: fileReadID, groupPlasticID, groupHomogID
+ integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID
- integer        :: hdferr
 
- mainProcess: if (worldrank == 0) then 
+ write(6,'(/,a)')   ' <<<+-  CPFEM init  -+>>>'
-   write(6,'(/,a)')   ' <<<+-  CPFEM init  -+>>>'
+ write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-   write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
 #include "compilation_info.f90"
-   flush(6)
+ flush(6)
- endif mainProcess
 
  ! *** restore the last converged values of each essential variable from the binary file
  if (restartRead) then
@@ -152,34 +151,38 @@ subroutine CPFEM_init
    
    write(rankStr,'(a1,i0)')'_',worldrank
 
-   fileReadID = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5')
+   fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5')
   
-   call HDF5_read(material_phase,      fileReadID,'recordedPhase')
+   call HDF5_read(fileHandle,material_phase,      'recordedPhase')
-   call HDF5_read(crystallite_F0,      fileReadID,'convergedF')
+   call HDF5_read(fileHandle,crystallite_F0,      'convergedF')
-   call HDF5_read(crystallite_Fp0,     fileReadID,'convergedFp')
+   call HDF5_read(fileHandle,crystallite_Fp0,     'convergedFp')
-   call HDF5_read(crystallite_Fi0,     fileReadID,'convergedFi')
+   call HDF5_read(fileHandle,crystallite_Fi0,     'convergedFi')
-   call HDF5_read(crystallite_Lp0,     fileReadID,'convergedLp')
+   call HDF5_read(fileHandle,crystallite_Lp0,     'convergedLp')
-   call HDF5_read(crystallite_Li0,     fileReadID,'convergedLi')
+   call HDF5_read(fileHandle,crystallite_Li0,     'convergedLi')
-   call HDF5_read(crystallite_dPdF0,   fileReadID,'convergeddPdF')
+   call HDF5_read(fileHandle,crystallite_Tstar0_v,'convergedTstar')
-   call HDF5_read(crystallite_Tstar0_v,fileReadID,'convergedTstar')
    
-   groupPlasticID = HDF5_openGroup2(fileReadID,'PlasticPhases')
+   groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases')
    do ph = 1_pInt,size(phase_plasticity)
     write(PlasticItem,*) ph,'_'
-    call HDF5_read(plasticState(ph)%state0,groupPlasticID,trim(PlasticItem)//'convergedStateConst')
+    call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
    enddo
+   call HDF5_closeGroup(groupPlasticID)
    
-   groupHomogID = HDF5_openGroup2(fileReadID,'HomogStates')
+   groupHomogID = HDF5_openGroup(fileHandle,'HomogStates')
    do homog = 1_pInt, material_Nhomogenization
     write(HomogItem,*) homog,'_'
-    call HDF5_read(homogState(homog)%state0, groupHomogID,trim(HomogItem)//'convergedStateHomog')
+    call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog')
    enddo
+   call HDF5_closeGroup(groupHomogID)
+
+   call HDF5_closeFile(fileHandle)
    
    restartRead = .false.
  endif
 
 end subroutine CPFEM_init
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief forwards data after successful increment
 !--------------------------------------------------------------------------------------------------
@@ -203,8 +206,6 @@ subroutine CPFEM_age()
    homogState, &
    thermalState, &
    damageState, &
-   vacancyfluxState, &
-   hydrogenfluxState, &
    material_phase, &
    phase_plasticity, &
    phase_Nsources
@@ -221,7 +222,6 @@ subroutine CPFEM_age()
    crystallite_Lp, &
    crystallite_Li0, &
    crystallite_Li, &
-   crystallite_dPdF0, &
    crystallite_dPdF, &
    crystallite_Tstar0_v, &
    crystallite_Tstar_v
@@ -231,84 +231,100 @@ subroutine CPFEM_age()
  use HDF5_utilities, only: &
    HDF5_openFile, &
    HDF5_closeFile, &
+   HDF5_addGroup, &
    HDF5_closeGroup, &
-   HDF5_addGroup2, &
    HDF5_write
  use hdf5
  use DAMASK_interface, only: &
    getSolverJobName
 
  implicit none
-
+ integer(pInt)    ::  i, ph, homog, mySource
- integer(pInt) ::                                    i, k, l, m, ph, homog, mySource
  character(len=32) :: rankStr, PlasticItem, HomogItem
  integer(HID_T) :: fileHandle, groupPlastic, groupHomog
- integer        :: hdferr
- integer(HSIZE_T)  :: hdfsize
 
-if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
+ if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
-  write(6,'(a)') '<< CPFEM >> aging states'
+   write(6,'(a)') '<< CPFEM >> aging states'
 
-  crystallite_F0  = crystallite_partionedF                                                    ! crystallite deformation (_subF is perturbed...)
+ crystallite_F0  = crystallite_partionedF
-  crystallite_Fp0 = crystallite_Fp                                                            ! crystallite plastic deformation
+ crystallite_Fp0 = crystallite_Fp
-  crystallite_Lp0 = crystallite_Lp                                                            ! crystallite plastic velocity
+ crystallite_Lp0 = crystallite_Lp
-  crystallite_Fi0 = crystallite_Fi                                                            ! crystallite intermediate deformation
+ crystallite_Fi0 = crystallite_Fi
-  crystallite_Li0 = crystallite_Li                                                            ! crystallite intermediate velocity
+ crystallite_Li0 = crystallite_Li
-  crystallite_dPdF0 = crystallite_dPdF                                                        ! crystallite stiffness
+ crystallite_Tstar0_v = crystallite_Tstar_v
-  crystallite_Tstar0_v = crystallite_Tstar_v                                                  ! crystallite 2nd Piola Kirchhoff stress
  
-  forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state            ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array
+ forall (i = 1:size(plasticState)) plasticState(i)%state0 = plasticState(i)%state            ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array
  
-  do i = 1, size(sourceState)
+ do i = 1, size(sourceState)
-    do mySource = 1,phase_Nsources(i)
+   do mySource = 1,phase_Nsources(i)
-      sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state                    ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array
+     sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state                    ! copy state in this lengthy way because: A component cannot be an array if the encompassing structure is an array
-  enddo; enddo
+ enddo; enddo
  
-  do homog = 1_pInt, material_Nhomogenization
+ do homog = 1_pInt, material_Nhomogenization
-    homogState       (homog)%state0 =  homogState       (homog)%state
+   homogState       (homog)%state0 =  homogState       (homog)%state
-    thermalState     (homog)%state0 =  thermalState     (homog)%state
+   thermalState     (homog)%state0 =  thermalState     (homog)%state
-    damageState      (homog)%state0 =  damageState      (homog)%state
+   damageState      (homog)%state0 =  damageState      (homog)%state
-    vacancyfluxState (homog)%state0 =  vacancyfluxState (homog)%state
+ enddo
-    hydrogenfluxState(homog)%state0 =  hydrogenfluxState(homog)%state
-  enddo
 
-if (restartWrite) then
+ if (restartWrite) then
-  if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
+   if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
-    write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file'
+     write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file'
-  write(rankStr,'(a1,i0)')'_',worldrank
    
-  fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','w')
+   write(rankStr,'(a1,i0)')'_',worldrank
+   fileHandle = HDF5_openFile(trim(getSolverJobName())//trim(rankStr)//'.hdf5','w')
    
-  call HDF5_write(material_phase,      fileHandle,'recordedPhase')
+   call HDF5_write(fileHandle,material_phase,      'recordedPhase')
-  call HDF5_write(crystallite_F0,      fileHandle,'convergedF')
+   call HDF5_write(fileHandle,crystallite_F0,      'convergedF')
-  call HDF5_write(crystallite_Fp0,     fileHandle,'convergedFp')
+   call HDF5_write(fileHandle,crystallite_Fp0,     'convergedFp')
-  call HDF5_write(crystallite_Fi0,     fileHandle,'convergedFi')
+   call HDF5_write(fileHandle,crystallite_Fi0,     'convergedFi')
-  call HDF5_write(crystallite_Lp0,     fileHandle,'convergedLp')
+   call HDF5_write(fileHandle,crystallite_Lp0,     'convergedLp')
-  call HDF5_write(crystallite_Li0,     fileHandle,'convergedLi')
+   call HDF5_write(fileHandle,crystallite_Li0,     'convergedLi')
-  call HDF5_write(crystallite_dPdF0,   fileHandle,'convergeddPdF')
+   call HDF5_write(fileHandle,crystallite_Tstar0_v,'convergedTstar')
-  call HDF5_write(crystallite_Tstar0_v,fileHandle,'convergedTstar')
    
-  groupPlastic = HDF5_addGroup2(fileHandle,'PlasticPhases')
+   groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases')
-  do ph = 1_pInt,size(phase_plasticity)
+   do ph = 1_pInt,size(phase_plasticity)
-    write(PlasticItem,*) ph,'_'
+     write(PlasticItem,*) ph,'_'
-    call HDF5_write(plasticState(ph)%state0,groupPlastic,trim(PlasticItem)//'convergedStateConst')
+     call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
-  enddo
+   enddo
-  call HDF5_closeGroup(groupPlastic)
+   call HDF5_closeGroup(groupPlastic)
 
-  groupHomog = HDF5_addGroup2(fileHandle,'HomogStates')
+   groupHomog = HDF5_addGroup(fileHandle,'HomogStates')
-  do homog = 1_pInt, material_Nhomogenization
+   do homog = 1_pInt, material_Nhomogenization
-    write(HomogItem,*) homog,'_'
+     write(HomogItem,*) homog,'_'
-    call HDF5_write(homogState(homog)%state0,groupHomog,trim(HomogItem)//'convergedStateHomog')
+     call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog')
-  enddo
+   enddo
-  call HDF5_closeGroup(groupHomog)
+   call HDF5_closeGroup(groupHomog)
    
-  call HDF5_closeFile(fileHandle)
+   call HDF5_closeFile(fileHandle)
-  restartWrite = .false.
+   restartWrite = .false.
-endif
+ endif
 
-if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
+ if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
-  write(6,'(a)') '<< CPFEM >> done aging states'
+   write(6,'(a)') '<< CPFEM >> done aging states'
 
 end subroutine CPFEM_age
 
+!--------------------------------------------------------------------------------------------------
+!> @brief triggers writing of the results
+!--------------------------------------------------------------------------------------------------
+subroutine CPFEM_results(inc,time)
+ use prec, only: &
+   pInt
+ use results
+ use HDF5_utilities
+ use constitutive, only: &
+   constitutive_results
+
+ implicit none
+ integer(pInt), intent(in) :: inc
+ real(pReal),   intent(in) :: time
+
+ call results_openJobFile
+ call results_addIncrement(inc,time)
+ call constitutive_results()
+ call results_removeLink('current') ! ToDo: put this into closeJobFile
+ call results_closeJobFile
+
+end subroutine CPFEM_results
+
 end module CPFEM2

src/C_routines.c

@@ -6,9 +6,11 @@
 #include <sys/stat.h>
 #include <stdio.h>
 #include <string.h>
+#include <signal.h>
 
 /* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */
 
+
 int isdirectory_c(const char *dir){
   struct stat statbuf;
   if(stat(dir, &statbuf) != 0)                                                                      /* error */
@@ -44,3 +46,11 @@ void gethostname_c(char hostname[], int *stat){
 int chdir_c(const char *dir){
   return chdir(dir);
 }
+
+void signalusr1_c(void (*handler)(int)){
+  signal(SIGUSR1, handler);
+}
+
+void signalusr2_c(void (*handler)(int)){
+  signal(SIGUSR2, handler);
+}

src/DAMASK_abaqus.f

@@ -102,8 +102,6 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
    calcMode, &
    terminallyIll, &
    symmetricSolver
- use math, only: &
-   invnrmMandel
  use debug, only: &
    debug_info, &
    debug_reset, &
@@ -305,9 +303,9 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
 !     ABAQUS implicit:     11, 22, 33, 12, 13, 23
 !     ABAQUS implicit:     11, 22, 33, 12
 
- forall(i=1:ntens) ddsdde(1:ntens,i) = invnrmMandel(i)*ddsdde_h(1:ntens,i)*invnrmMandel(1:ntens)
+ ddsdde = ddsdde_h(1:ntens,1:ntens)
- stress(1:ntens) = stress_h(1:ntens)*invnrmMandel(1:ntens)
+ stress = stress_h(1:ntens)
- if(symmetricSolver) ddsdde(1:ntens,1:ntens) = 0.5_pReal*(ddsdde(1:ntens,1:ntens) + transpose(ddsdde(1:ntens,1:ntens)))
+ if(symmetricSolver) ddsdde = 0.5_pReal*(ddsdde + transpose(ddsdde))
  if(ntens == 6) then
    stress_h = stress
    stress(5) = stress_h(6)
@@ -322,8 +320,8 @@ subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
 
  statev = materialpoint_results(1:min(nstatv,materialpoint_sizeResults),npt,mesh_FEasCP('elem', noel))
 
- if ( terminallyIll ) pnewdt = 0.5_pReal                                                            ! force cutback directly ?
+ if (terminallyIll) pnewdt = 0.5_pReal                                                              ! force cutback directly ?
-!$ call omp_set_num_threads(defaultNumThreadsInt)                                                  ! reset number of threads to stored default value
+!$ call omp_set_num_threads(defaultNumThreadsInt)                                                   ! reset number of threads to stored default value
 
 end subroutine UMAT
 
@@ -331,12 +329,12 @@ end subroutine UMAT
 !--------------------------------------------------------------------------------------------------
 !> @brief calls the exit function of Abaqus/Standard
 !--------------------------------------------------------------------------------------------------
-subroutine quit(mpie_error)
+subroutine quit(DAMASK_error)
  use prec, only: &
    pInt
  
  implicit none
- integer(pInt) :: mpie_error
+ integer(pInt) :: DAMASK_error
 
  flush(6)
  call xit

src/DAMASK_interface.f90

@@ -12,9 +12,9 @@
 module DAMASK_interface
  use prec, only: &
    pInt
-
  implicit none
  private
+ logical, public, protected :: SIGUSR1,SIGUSR2
  integer(pInt),       public, protected :: &
    interface_restartInc = 0_pInt                                                                    !< Increment at which calculation starts
  character(len=1024), public, protected :: &
@@ -42,6 +42,8 @@ contains
 subroutine DAMASK_interface_init()
  use, intrinsic :: &
    iso_fortran_env
+ use :: &
+   iso_c_binding
 #include <petsc/finclude/petscsys.h>
 #if defined(__GFORTRAN__) &&  __GNUC__ < 5
 ===================================================================================================
@@ -81,6 +83,8 @@ subroutine DAMASK_interface_init()
 
  use PETScSys
  use system_routines, only: &
+   signalusr1_C, &
+   signalusr2_C, &
    getHostName, &
    getCWD
 
@@ -229,6 +233,12 @@ subroutine DAMASK_interface_init()
  if (interface_restartInc > 0_pInt) &
    write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc
 
+ call signalusr1_c(c_funloc(setSIGUSR1))
+ call signalusr2_c(c_funloc(setSIGUSR2))
+ SIGUSR1 = .false.
+ SIGUSR2 = .false.
+
+
 end subroutine DAMASK_interface_init
 
 
@@ -412,6 +422,35 @@ character(len=1024) function makeRelativePath(a,b)
 
 end function makeRelativePath
 
+!--------------------------------------------------------------------------------------------------
+!> @brief sets global variable SIGUSR1 to .true. if program receives SIGUSR1
+!--------------------------------------------------------------------------------------------------
+subroutine setSIGUSR1(signal) bind(C)
+ use :: iso_c_binding
+   
+ implicit none
+ integer(C_INT), value :: signal
+ SIGUSR1 = .true.
+ 
+ write(6,*) 'received signal ',signal, 'set SIGUSR1'
+ 
+end subroutine setSIGUSR1
+ 
+ 
+!--------------------------------------------------------------------------------------------------
+!> @brief sets global variable SIGUSR2 to .true. if program receives SIGUSR2
+!--------------------------------------------------------------------------------------------------
+subroutine setSIGUSR2(signal) bind(C)
+ use :: iso_c_binding
+
+ implicit none
+ integer(C_INT), value :: signal
+ SIGUSR2 = .true.
+
+ write(6,*) 'received signal ',signal, 'set SIGUSR2'
+  
+end subroutine setSIGUSR2
+
 
 !--------------------------------------------------------------------------------------------------
 !> @brief taken from IO, check IO_stringValue for documentation 
@@ -469,7 +508,6 @@ pure function IIO_stringPos(string)
  do while (verify(string(right+1:),SEP)>0)
    left  = right + verify(string(right+1:),SEP)
    right = left + scan(string(left:),SEP) - 2
-   if ( string(left:left) == '#' ) exit
    IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)]
    IIO_stringPos(1) = IIO_stringPos(1)+1_pInt
  enddo

src/DAMASK_marc.f90

@@ -127,9 +127,6 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
    calcMode, &
    terminallyIll, &
    symmetricSolver
- use math, only: &
-   math_transpose33,&
-   invnrmMandel
  use debug, only: &
    debug_level, &
    debug_LEVELBASIC, &
@@ -235,9 +232,9 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
    write(6,'(a,i12)')        ' Nodes:                         ', nnode
    write(6,'(a,i1)')         ' Deformation gradient:          ', itel
    write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n:', &
-                                 math_transpose33(ffn)
+                                 transpose(ffn)
    write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n+1:', &
-                                 math_transpose33(ffn1)
+                                 transpose(ffn1)
  endif
 
  !$ defaultNumThreadsInt = omp_get_num_threads()                                                    ! remember number of threads set by Marc
@@ -357,8 +354,8 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
 !     Marc:   11, 22, 33, 12, 23, 13
 !     Marc:   11, 22, 33, 12
 
- forall(i=1:ngens) d(1:ngens,i) = invnrmMandel(i)*ddsdde(1:ngens,i)*invnrmMandel(1:ngens)
+ d = ddsdde(1:ngens,1:ngens)
- s(1:ndi+nshear) = stress(1:ndi+nshear)*invnrmMandel(1:ndi+nshear)
+ s = stress(1:ndi+nshear)
  g = 0.0_pReal
  if(symmetricSolver) d = 0.5_pReal*(d+transpose(d))
 

src/DAMASK_spectral.f90

@@ -46,7 +46,8 @@ program DAMASK_spectral
    grid, &
    geomSize
  use CPFEM2, only: &
-   CPFEM_initAll
+   CPFEM_initAll, &
+   CPFEM_results
  use FEsolving, only: &
    restartWrite, &
    restartInc
@@ -80,6 +81,7 @@ program DAMASK_spectral
  use spectral_mech_Polarisation
  use spectral_damage
  use spectral_thermal
+ use results
 
  implicit none
 
@@ -157,6 +159,9 @@ program DAMASK_spectral
  write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
 #include "compilation_info.f90"
 
+
+ call results_openJobFile()
+ call results_closeJobFile()
 !--------------------------------------------------------------------------------------------------
 ! initialize field solver information
  nActiveFields = 1
@@ -420,6 +425,7 @@ program DAMASK_spectral
 
  writeUndeformed: if (interface_restartInc < 1_pInt) then
    write(6,'(1/,a)') ' ... writing initial configuration to file ........................'
+   call CPFEM_results(0_pInt,0.0_pReal)
    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)
@@ -596,6 +602,7 @@ program DAMASK_spectral
            if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write')
          enddo
          fileOffset = fileOffset + sum(outputSize)                                                  ! forward to current file position
+         call CPFEM_results(totalIncsCounter,time)
        endif
        if (              loadCases(currentLoadCase)%restartFrequency > 0_pInt &                     ! writing of restart info requested ...
            .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then               ! ... and at frequency of writing restart information

src/FEM_utilities.f90

@@ -162,7 +162,6 @@ subroutine utilities_init()
 
  character(len=1024)                :: petsc_optionsPhysics
  integer(pInt)                      :: dimPlex
- integer(pInt)                      :: headerID = 205_pInt
  PetscInt,    allocatable           :: nEntities(:), nOutputCells(:), nOutputNodes(:)
  PetscInt                           :: dim
  PetscErrorCode                     :: ierr
@@ -213,13 +212,6 @@ subroutine utilities_init()
  nOutputCells(worldrank+1) = count(material_homog > 0_pInt)
  call MPI_Allreduce(MPI_IN_PLACE,nOutputNodes,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
  call MPI_Allreduce(MPI_IN_PLACE,nOutputCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
- if (worldrank == 0_pInt) then
-   open(unit=headerID, file=trim(getSolverJobName())//'.header', &
-        form='FORMATTED', status='REPLACE')
-   write(headerID, '(a,i0)') 'dimension : ',   dimPlex                                             
-   write(headerID, '(a,i0)') 'number of nodes : ', sum(nOutputNodes)
-   write(headerID, '(a,i0)') 'number of cells : ', sum(nOutputCells)
- endif 
 
 end subroutine utilities_init
 

src/IO.f90

@@ -186,10 +186,9 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
     fileUnit, &
     startPos, endPos, &
     myTotalLines, &                                                                                 !< # lines read from file without include statements
-    includedLines, &                                                                                !< # lines included from other file(s)
-    missingLines, &                                                                                 !< # lines missing from current file
     l,i, &
     myStat
+  logical :: warned
   
   if (present(cnt)) then
     if (cnt>10_pInt) call IO_error(106_pInt,ext_msg=trim(fileName))
@@ -207,37 +206,39 @@ recursive function IO_recursiveRead(fileName,cnt) result(fileContent)
 
 !--------------------------------------------------------------------------------------------------
 ! count lines to allocate string array
-  myTotalLines = 0_pInt
+  myTotalLines = 1_pInt
   do l=1_pInt, len(rawData)
-    if (rawData(l:l) == new_line('') .or. l==len(rawData)) myTotalLines = myTotalLines+1            ! end of line or end of file without new line
+    if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1
   enddo
   allocate(fileContent(myTotalLines))
 
 !--------------------------------------------------------------------------------------------------
 ! split raw data at end of line and handle includes
+  warned = .false.
   startPos = 1_pInt
-  endPos = 0_pInt
+  l = 1_pInt
+  do while (l <= myTotalLines)
+    endPos = merge(startPos + scan(rawData(startPos:),new_line('')) - 2_pInt,len(rawData),l /= myTotalLines)
+    if (endPos - startPos > 255_pInt) then
+      line = rawData(startPos:startPos+255_pInt)
+      if (.not. warned) then
+        call IO_warning(207_pInt,ext_msg=trim(fileName),el=l)
+        warned = .true.
+      endif
+    else
+      line = rawData(startPos:endpos)
+    endif
+    startPos = endPos + 2_pInt                                                                        ! jump to next line start
 
-  includedLines=0_pInt
+    recursion: if (scan(trim(adjustl(line)),'{') == 1 .and. scan(trim(line),'}') > 2) then
-  l=0_pInt
-  do while (startPos <= len(rawData))
-    l = l + 1_pInt
-    endPos = endPos + scan(rawData(startPos:),new_line(''))
-    if(endPos < startPos) endPos = len(rawData)                                                     ! end of file without end of line
-    if(endPos - startPos >256) call IO_error(107_pInt,ext_msg=trim(fileName))
-    line = rawData(startPos:endPos-1_pInt)
-    startPos = endPos + 1_pInt
-
-    recursion: if(scan(trim(line),'{') < scan(trim(line),'}')) then
-      myTotalLines    = myTotalLines - 1_pInt
       includedContent = IO_recursiveRead(trim(line(scan(line,'{')+1_pInt:scan(line,'}')-1_pInt)), &
-                        merge(cnt,1_pInt,present(cnt)))                                             ! to track recursion depth
+                        merge(cnt,1_pInt,present(cnt)))                                               ! to track recursion depth
-      includedLines   = includedLines + size(includedContent)
+      fileContent     = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,myTotalLines-l)] ]    ! add content and grow array
-      missingLines    = myTotalLines + includedLines - size(fileContent(1:l-1)) -size(includedContent)
+      myTotalLines    = myTotalLines - 1_pInt + size(includedContent)
-      fileContent     = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,missingLines)] ]    ! add content and grow array
+      l               = l            - 1_pInt + size(includedContent)
-      l = l - 1_pInt + size(includedContent)
     else recursion
       fileContent(l) = line
+      l = l + 1_pInt
     endif recursion
 
   enddo
@@ -1236,6 +1237,10 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
    msg = 'zero entry on stiffness diagonal'
  case (136_pInt)
    msg = 'zero entry on stiffness diagonal for transformed phase'
+ case (137_pInt)
+   msg = 'not defined for lattice structure'
+ case (138_pInt)
+   msg = 'not enough interaction parameters given'
 
 !--------------------------------------------------------------------------------------------------
 ! errors related to the parsing of material.config
@@ -1251,6 +1256,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg)
    msg = 'negative number systems requested'
  case (145_pInt)
    msg = 'too many systems requested'
+ case (146_pInt)
+   msg = 'number of values does not match'
 
 !--------------------------------------------------------------------------------------------------
 ! material error messages and related messages in mesh
@@ -1492,6 +1499,8 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg)
    msg = 'invalid character in string chunk'
  case (203_pInt)
    msg = 'interpretation of string chunk failed'
+ case (207_pInt)
+   msg = 'line truncated'
  case (600_pInt)
    msg = 'crystallite responds elastically'
  case (601_pInt)

src/commercialFEM_fileList.f90

@@ -4,12 +4,12 @@
 !> @details List of files needed by MSC.Marc, Abaqus/Explicit, and Abaqus/Standard
 !--------------------------------------------------------------------------------------------------
 #include "IO.f90"
-#ifdef DAMASKHDF5
-#include "HDF5_utilities.f90"
-#endif
 #include "numerics.f90"
 #include "debug.f90"
 #include "config.f90"
+#ifdef DAMASKHDF5
+#include "HDF5_utilities.f90"
+#endif
 #include "math.f90"
 #include "FEsolving.f90"
 #include "mesh.f90"
@@ -21,14 +21,9 @@
 #include "source_damage_isoDuctile.f90"
 #include "source_damage_anisoBrittle.f90"
 #include "source_damage_anisoDuctile.f90"
-#include "source_vacancy_phenoplasticity.f90"
-#include "source_vacancy_irradiation.f90"
-#include "source_vacancy_thermalfluc.f90"
 #include "kinematics_cleavage_opening.f90"
 #include "kinematics_slipplane_opening.f90"
 #include "kinematics_thermal_expansion.f90"
-#include "kinematics_vacancy_strain.f90"
-#include "kinematics_hydrogen_strain.f90"
 #include "plastic_none.f90"
 #include "plastic_isotropic.f90"
 #include "plastic_phenopowerlaw.f90"
@@ -47,12 +42,5 @@
 #include "damage_none.f90"
 #include "damage_local.f90"
 #include "damage_nonlocal.f90"
-#include "vacancyflux_isoconc.f90"
-#include "vacancyflux_isochempot.f90"
-#include "vacancyflux_cahnhilliard.f90"
-#include "porosity_none.f90"
-#include "porosity_phasefield.f90"
-#include "hydrogenflux_isoconc.f90"
-#include "hydrogenflux_cahnhilliard.f90"
 #include "homogenization.f90"
 #include "CPFEM.f90"

src/compilation_info.f90

@@ -1,9 +1,13 @@
+! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
 #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
   write(6,*) 'Compiled with ', compiler_version()
   write(6,*) 'With options  ', compiler_options()
-#else
+#elif defined(__INTEL_COMPILER)
   write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,&
                                                      ', build date ', __INTEL_COMPILER_BUILD_DATE
+#elif defined(__PGI)
+  write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version ', __PGIC__,&
+                                                               '.', __PGIC_MINOR__
 #endif
 write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
 write(6,*)

src/config.f90

@@ -1,4 +1,4 @@
-!--------------------------------------------------------------------------------------------------
+!-------------------------------------------------------------------------------------------------
 !> @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
@@ -220,7 +220,7 @@ subroutine parseFile(sectionNames,part,line, &
  partPosition = [partPosition, i]                                                                   ! needed when actually storing content
 
  do i = 1_pInt, size(partPosition) -1_pInt
-   sectionNames(i) = trim(adjustl(fileContent(partPosition(i))))
+   sectionNames(i) = trim(adjustl(IO_getTag(fileContent(partPosition(i)),'[',']')))
    do j = partPosition(i) + 1_pInt,  partPosition(i+1) -1_pInt
      call part(i)%add(trim(adjustl(fileContent(j))))
    enddo
@@ -318,7 +318,7 @@ subroutine show(this)
  do while (associated(item%next))
    write(6,'(a)') ' '//trim(item%string%val)
    item => item%next
- end do
+ enddo
 
 end subroutine show
 
@@ -391,7 +391,7 @@ logical function keyExists(this,key)
  do while (associated(item%next) .and. .not. keyExists)
    keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)
    item => item%next
- end do
+ enddo
 
 end function keyExists
 
@@ -417,7 +417,7 @@ integer(pInt) function countKeys(this,key)
    if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) &
      countKeys = countKeys + 1_pInt
    item => item%next
- end do
+ enddo
 
 end function countKeys
 
@@ -451,7 +451,7 @@ real(pReal) function getFloat(this,key,defaultVal)
      getFloat = IO_FloatValue(item%string%val,item%string%pos,2)
    endif
    item => item%next
- end do
+ enddo
 
  if (.not. found) call IO_error(140_pInt,ext_msg=key)
 
@@ -487,7 +487,7 @@ integer(pInt) function getInt(this,key,defaultVal)
      getInt = IO_IntValue(item%string%val,item%string%pos,2)
    endif
    item => item%next
- end do
+ enddo
 
  if (.not. found) call IO_error(140_pInt,ext_msg=key)
 
@@ -538,7 +538,7 @@ character(len=65536) function getString(this,key,defaultVal,raw)
      endif
    endif
    item => item%next
- end do
+ enddo
 
  if (.not. found) call IO_error(140_pInt,ext_msg=key)
 
@@ -550,7 +550,7 @@ end function getString
 !> @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)
+function getFloats(this,key,defaultVal,requiredSize)
  use IO, only: &
    IO_error, &
    IO_stringValue, &
@@ -561,7 +561,7 @@ function getFloats(this,key,defaultVal,requiredShape)
  class(tPartitionedStringList), target, intent(in)   :: this
  character(len=*),              intent(in)           :: key
  real(pReal),   dimension(:),   intent(in), optional :: defaultVal
- integer(pInt), dimension(:),   intent(in), optional :: requiredShape
+ integer(pInt),                 intent(in), optional :: requiredSize
  type(tPartitionedStringList),  pointer              :: item
  integer(pInt)                                       :: i
  logical                                             :: found, &
@@ -583,11 +583,14 @@ function getFloats(this,key,defaultVal,requiredShape)
      enddo
    endif
    item => item%next
- end do
+ enddo
 
  if (.not. found) then
    if (present(defaultVal)) then; getFloats = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
  endif
+ if (present(requiredSize)) then
+   if(requiredSize /= size(getFloats)) call IO_error(146,ext_msg=key)
+ endif
 
 end function getFloats
 
@@ -597,7 +600,7 @@ end function getFloats
 !> @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)
+function getInts(this,key,defaultVal,requiredSize)
  use IO, only: &
    IO_error, &
    IO_stringValue, &
@@ -607,8 +610,8 @@ function getInts(this,key,defaultVal,requiredShape)
  integer(pInt), dimension(:), allocatable            :: getInts
  class(tPartitionedStringList), target, intent(in)   :: this
  character(len=*),              intent(in)           :: key
- integer(pInt), dimension(:),   intent(in), optional :: defaultVal, &
+ integer(pInt), dimension(:),   intent(in), optional :: defaultVal
-                                                        requiredShape
+ integer(pInt),                 intent(in), optional :: requiredSize
  type(tPartitionedStringList),  pointer              :: item
  integer(pInt)                                       :: i
  logical                                             :: found, &
@@ -630,11 +633,14 @@ function getInts(this,key,defaultVal,requiredShape)
      enddo
    endif
    item => item%next
- end do
+ enddo
 
  if (.not. found) then
    if (present(defaultVal)) then; getInts = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif
  endif
+ if (present(requiredSize)) then
+   if(requiredSize /= size(getInts)) call IO_error(146,ext_msg=key)
+ endif
 
 end function getInts
 
@@ -645,7 +651,7 @@ end function getInts
 !! 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)
+function getStrings(this,key,defaultVal,raw)
  use IO, only: &
    IO_error, &
    IO_StringValue
@@ -655,7 +661,6 @@ function getStrings(this,key,defaultVal,requiredShape,raw)
  class(tPartitionedStringList), target, intent(in)        :: this
  character(len=*),                   intent(in)           :: key
  character(len=65536),dimension(:),  intent(in), optional :: defaultVal
- integer(pInt),       dimension(:),  intent(in), optional :: requiredShape
  logical,                            intent(in), optional :: raw
  type(tPartitionedStringList), pointer                    :: item
  character(len=65536)                                     :: str
@@ -704,7 +709,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw)
      endif notAllocated
    endif
    item => item%next
- end do
+ enddo
 
  if (.not. found) then
    if (present(defaultVal)) then; getStrings = defaultVal; else; call IO_error(140_pInt,ext_msg=key); endif

src/constitutive.f90

@@ -25,7 +25,8 @@ module constitutive
    constitutive_SandItsTangents, &
    constitutive_collectDotState, &
    constitutive_collectDeltaState, &
-   constitutive_postResults
+   constitutive_postResults, &
+   constitutive_results
 
  private :: &
    constitutive_hooke_SandItsTangents
@@ -88,14 +89,9 @@ subroutine constitutive_init()
    SOURCE_damage_isoDuctile_ID, &
    SOURCE_damage_anisoBrittle_ID, &
    SOURCE_damage_anisoDuctile_ID, &
-   SOURCE_vacancy_phenoplasticity_ID, &
-   SOURCE_vacancy_irradiation_ID, &
-   SOURCE_vacancy_thermalfluc_ID, &
    KINEMATICS_cleavage_opening_ID, &
    KINEMATICS_slipplane_opening_ID, &
    KINEMATICS_thermal_expansion_ID, &
-   KINEMATICS_vacancy_strain_ID, &
-   KINEMATICS_hydrogen_strain_ID, &
    ELASTICITY_HOOKE_label, &
    PLASTICITY_NONE_label, &
    PLASTICITY_ISOTROPIC_label, &
@@ -110,9 +106,6 @@ subroutine constitutive_init()
    SOURCE_damage_isoDuctile_label, &
    SOURCE_damage_anisoBrittle_label, &
    SOURCE_damage_anisoDuctile_label, &
-   SOURCE_vacancy_phenoplasticity_label, &
-   SOURCE_vacancy_irradiation_label, &
-   SOURCE_vacancy_thermalfluc_label, &
    plasticState, &
    sourceState
 
@@ -129,14 +122,9 @@ subroutine constitutive_init()
  use source_damage_isoDuctile
  use source_damage_anisoBrittle
  use source_damage_anisoDuctile
- use source_vacancy_phenoplasticity
- use source_vacancy_irradiation
- use source_vacancy_thermalfluc
  use kinematics_cleavage_opening
  use kinematics_slipplane_opening
  use kinematics_thermal_expansion
- use kinematics_vacancy_strain
- use kinematics_hydrogen_strain
 
  implicit none
  integer(pInt), parameter :: FILEUNIT = 204_pInt
@@ -162,8 +150,8 @@ subroutine constitutive_init()
  if (any(phase_plasticity == PLASTICITY_NONE_ID))          call plastic_none_init
  if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID))     call plastic_isotropic_init
  if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init
- if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT)
+ if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init
- if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID))     call plastic_dislotwin_init(FILEUNIT)
+ if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID))     call plastic_dislotwin_init
  if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID))     call plastic_disloucla_init
  if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then
   call plastic_nonlocal_init(FILEUNIT)
@@ -179,9 +167,6 @@ subroutine constitutive_init()
  if (any(phase_source == SOURCE_damage_isoDuctile_ID))       call source_damage_isoDuctile_init(FILEUNIT)
  if (any(phase_source == SOURCE_damage_anisoBrittle_ID))     call source_damage_anisoBrittle_init(FILEUNIT)
  if (any(phase_source == SOURCE_damage_anisoDuctile_ID))     call source_damage_anisoDuctile_init(FILEUNIT)
- if (any(phase_source == SOURCE_vacancy_phenoplasticity_ID)) call source_vacancy_phenoplasticity_init(FILEUNIT)
- if (any(phase_source == SOURCE_vacancy_irradiation_ID))     call source_vacancy_irradiation_init(FILEUNIT)
- if (any(phase_source == SOURCE_vacancy_thermalfluc_ID))     call source_vacancy_thermalfluc_init(FILEUNIT)
 
 !--------------------------------------------------------------------------------------------------
 ! parse kinematic mechanisms from config file
@@ -189,8 +174,6 @@ subroutine constitutive_init()
  if (any(phase_kinematics == KINEMATICS_cleavage_opening_ID))  call kinematics_cleavage_opening_init
  if (any(phase_kinematics == KINEMATICS_slipplane_opening_ID)) call kinematics_slipplane_opening_init
  if (any(phase_kinematics == KINEMATICS_thermal_expansion_ID)) call kinematics_thermal_expansion_init(FILEUNIT)
- if (any(phase_kinematics == KINEMATICS_vacancy_strain_ID))    call kinematics_vacancy_strain_init(FILEUNIT)
- if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID))   call kinematics_hydrogen_strain_init(FILEUNIT)
  close(FILEUNIT)
 
  call config_deallocate('material.config/phase')
@@ -283,21 +266,6 @@ subroutine constitutive_init()
              outputName = SOURCE_damage_anisoDuctile_label
              thisOutput => source_damage_anisoDuctile_output
              thisSize   => source_damage_anisoDuctile_sizePostResult
-           case (SOURCE_vacancy_phenoplasticity_ID) sourceType
-             ins = source_vacancy_phenoplasticity_instance(ph)
-             outputName = SOURCE_vacancy_phenoplasticity_label
-             thisOutput => source_vacancy_phenoplasticity_output
-             thisSize   => source_vacancy_phenoplasticity_sizePostResult
-           case (SOURCE_vacancy_irradiation_ID) sourceType
-             ins = source_vacancy_irradiation_instance(ph)
-             outputName = SOURCE_vacancy_irradiation_label
-             thisOutput => source_vacancy_irradiation_output
-             thisSize   => source_vacancy_irradiation_sizePostResult
-           case (SOURCE_vacancy_thermalfluc_ID) sourceType
-             ins = source_vacancy_thermalfluc_instance(ph)
-             outputName = SOURCE_vacancy_thermalfluc_label
-             thisOutput => source_vacancy_thermalfluc_output
-             thisSize   => source_vacancy_thermalfluc_sizePostResult
            case default sourceType
              knownSource = .false.
          end select sourceType
@@ -397,7 +365,7 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el)
  use plastic_nonlocal, only: &
    plastic_nonlocal_microstructure
  use plastic_dislotwin, only: &
-   plastic_dislotwin_microstructure
+   plastic_dislotwin_dependentState
  use plastic_disloUCLA, only: &
    plastic_disloUCLA_dependentState
 
@@ -421,7 +389,9 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el)
 
  plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
    case (PLASTICITY_DISLOTWIN_ID) plasticityType
-     call plastic_dislotwin_microstructure(temperature(ho)%p(tme),ipc,ip,el)
+     of = phasememberAt(ipc,ip,el)
+     instance = phase_plasticityInstance(material_phase(ipc,ip,el))
+     call plastic_dislotwin_dependentState(temperature(ho)%p(tme),instance,of)
    case (PLASTICITY_DISLOUCLA_ID) plasticityType
      of = phasememberAt(ipc,ip,el)
      instance = phase_plasticityInstance(material_phase(ipc,ip,el))
@@ -441,9 +411,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
    pReal
  use math, only: &
    math_mul33x33, &
-   math_Mandel6to33, &
+   math_6toSym33, &
-   math_Mandel33to6, &
+   math_sym33to6, &
-   math_Plain99to3333
+   math_99to3333
  use material, only: &
    phasememberAt, &
    phase_plasticity, &
@@ -502,7 +472,7 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
  ho = material_homogenizationAt(el)
  tme = thermalMapping(ho)%p(ip,el)
 
- S  = math_Mandel6to33(S6)
+ S  = math_6toSym33(S6)
  Mp  = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S)
 
  plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
@@ -512,8 +482,9 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
      dLp_dMp = 0.0_pReal
 
    case (PLASTICITY_ISOTROPIC_ID) plasticityType
-     call plastic_isotropic_LpAndItsTangent       (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el)
+     of = phasememberAt(ipc,ip,el)
-     dLp_dMp = math_Plain99to3333(dLp_dMp99)                                                        ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget
+     instance = phase_plasticityInstance(material_phase(ipc,ip,el))
+     call plastic_isotropic_LpAndItsTangent       (Lp,dLp_dMp,Mp,instance,of)
 
    case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType
      of = phasememberAt(ipc,ip,el)
@@ -521,13 +492,14 @@ subroutine constitutive_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, S6, Fi, ipc, ip, e
      call plastic_phenopowerlaw_LpAndItsTangent   (Lp,dLp_dMp,Mp,instance,of)
 
    case (PLASTICITY_KINEHARDENING_ID) plasticityType
-     call plastic_kinehardening_LpAndItsTangent   (Lp,dLp_dMp99, math_Mandel33to6(Mp),ipc,ip,el)
+     of = phasememberAt(ipc,ip,el)
-     dLp_dMp = math_Plain99to3333(dLp_dMp99)                                                        ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget
+     instance = phase_plasticityInstance(material_phase(ipc,ip,el))
+     call plastic_kinehardening_LpAndItsTangent   (Lp,dLp_dMp, Mp,instance,of)
 
    case (PLASTICITY_NONLOCAL_ID) plasticityType
-     call plastic_nonlocal_LpAndItsTangent        (Lp,dLp_dMp99, math_Mandel33to6(Mp), &
+     call plastic_nonlocal_LpAndItsTangent        (Lp,dLp_dMp99, math_sym33to6(Mp), &
                                                    temperature(ho)%p(tme),ip,el)
-     dLp_dMp = math_Plain99to3333(dLp_dMp99)                                                        ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget
+     dLp_dMp = math_99to3333(dLp_dMp99)                                                             ! ToDo: We revert here the last statement in plastic_xx_LpAndItsTanget
 
    case (PLASTICITY_DISLOTWIN_ID) plasticityType
      of = phasememberAt(ipc,ip,el)
@@ -560,6 +532,7 @@ end subroutine constitutive_LpAndItsTangents
 
 !--------------------------------------------------------------------------------------------------
 !> @brief  contains the constitutive equation for calculating the velocity gradient
+! ToDo: MD: S is Mi?
 !--------------------------------------------------------------------------------------------------
 subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, el)
  use prec, only: &
@@ -568,8 +541,12 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
    math_I3, &
    math_inv33, &
    math_det33, &
-   math_mul33x33
+   math_mul33x33, &
+   math_6toSym33
  use material, only: &
+   phasememberAt, &
+   phase_plasticity, &
+   phase_plasticityInstance, &
    phase_plasticity, &
    material_phase, &
    phase_kinematics, &
@@ -577,9 +554,7 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
    PLASTICITY_isotropic_ID, &
    KINEMATICS_cleavage_opening_ID, &
    KINEMATICS_slipplane_opening_ID, &
-   KINEMATICS_thermal_expansion_ID, &
+   KINEMATICS_thermal_expansion_ID
-   KINEMATICS_vacancy_strain_ID, &
-   KINEMATICS_hydrogen_strain_ID
  use plastic_isotropic, only: &
    plastic_isotropic_LiAndItsTangent
  use kinematics_cleavage_opening, only: &
@@ -588,10 +563,6 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
    kinematics_slipplane_opening_LiAndItsTangent
  use kinematics_thermal_expansion, only: &
    kinematics_thermal_expansion_LiAndItsTangent
- use kinematics_vacancy_strain, only: &
-   kinematics_vacancy_strain_LiAndItsTangent
- use kinematics_hydrogen_strain, only: &
-   kinematics_hydrogen_strain_LiAndItsTangent
 
  implicit none
  integer(pInt), intent(in) :: &
@@ -607,19 +578,18 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
  real(pReal),   intent(out), dimension(3,3,3,3) :: &
    dLi_dS, &                                                                                        !< derivative of Li with respect to S
    dLi_dFi
+ 
  real(pReal), dimension(3,3) :: &
-   my_Li                                                                                            !< intermediate velocity gradient
+   my_Li, &                                                                                            !< intermediate velocity gradient
- real(pReal), dimension(3,3,3,3) :: &
-   my_dLi_dS
- real(pReal), dimension(3,3) :: &
    FiInv, &
    temp_33
+ real(pReal), dimension(3,3,3,3) :: &
+   my_dLi_dS
  real(pReal) :: &
    detFi
  integer(pInt) :: &
-   k                                                                                                !< counter in kinematics loop
+   k, i, j, &
- integer(pInt) :: &
+   instance, of
-   i, j
 
  Li = 0.0_pReal
  dLi_dS  = 0.0_pReal
@@ -627,7 +597,9 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
 
  plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
    case (PLASTICITY_isotropic_ID) plasticityType
-     call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el)
+     of = phasememberAt(ipc,ip,el)
+     instance = phase_plasticityInstance(material_phase(ipc,ip,el))
+     call plastic_isotropic_LiAndItsTangent(my_Li, my_dLi_dS, math_6toSym33(S6),instance,of)
    case default plasticityType
      my_Li = 0.0_pReal
      my_dLi_dS = 0.0_pReal
@@ -644,10 +616,6 @@ subroutine constitutive_LiAndItsTangents(Li, dLi_dS, dLi_dFi, S6, Fi, ipc, ip, e
        call kinematics_slipplane_opening_LiAndItsTangent(my_Li, my_dLi_dS, S6, ipc, ip, el)
      case (KINEMATICS_thermal_expansion_ID) kinematicsType
        call kinematics_thermal_expansion_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el)
-     case (KINEMATICS_vacancy_strain_ID) kinematicsType
-       call kinematics_vacancy_strain_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el)
-     case (KINEMATICS_hydrogen_strain_ID) kinematicsType
-       call kinematics_hydrogen_strain_LiAndItsTangent(my_Li, my_dLi_dS, ipc, ip, el)
      case default kinematicsType
        my_Li = 0.0_pReal
        my_dLi_dS = 0.0_pReal
@@ -684,15 +652,9 @@ pure function constitutive_initialFi(ipc, ip, el)
    phase_kinematics, &
    phase_Nkinematics, &
    material_phase, &
-   KINEMATICS_thermal_expansion_ID, &
+   KINEMATICS_thermal_expansion_ID
-   KINEMATICS_vacancy_strain_ID, &
-   KINEMATICS_hydrogen_strain_ID
  use kinematics_thermal_expansion, only: &
    kinematics_thermal_expansion_initialStrain
- use kinematics_vacancy_strain, only: &
-   kinematics_vacancy_strain_initialStrain
- use kinematics_hydrogen_strain, only: &
-   kinematics_hydrogen_strain_initialStrain
 
  implicit none
  integer(pInt), intent(in) :: &
@@ -711,12 +673,6 @@ pure function constitutive_initialFi(ipc, ip, el)
      case (KINEMATICS_thermal_expansion_ID) kinematicsType
        constitutive_initialFi = &
          constitutive_initialFi + kinematics_thermal_expansion_initialStrain(ipc, ip, el)
-     case (KINEMATICS_vacancy_strain_ID) kinematicsType
-       constitutive_initialFi = &
-         constitutive_initialFi + kinematics_vacancy_strain_initialStrain(ipc, ip, el)
-     case (KINEMATICS_hydrogen_strain_ID) kinematicsType
-       constitutive_initialFi = &
-         constitutive_initialFi + kinematics_hydrogen_strain_initialStrain(ipc, ip, el)
    end select kinematicsType
  enddo KinematicsLoop
 
@@ -762,7 +718,7 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip
  use math, only : &
    math_mul33x33, &
    math_mul3333xx33, &
-   math_Mandel66to3333, &
+   math_66toSym3333, &
    math_I3
  use material, only: &
    material_phase, &
@@ -771,10 +727,7 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip
    phase_stiffnessDegradation, &
    damage, &
    damageMapping, &
-   porosity, &
+   STIFFNESS_DEGRADATION_damage_ID
-   porosityMapping, &
-   STIFFNESS_DEGRADATION_damage_ID, &
-   STIFFNESS_DEGRADATION_porosity_ID
 
  implicit none
  integer(pInt), intent(in) :: &
@@ -798,14 +751,12 @@ subroutine constitutive_hooke_SandItsTangents(S, dS_dFe, dS_dFi, Fe, Fi, ipc, ip
    i, j
 
  ho = material_homogenizationAt(el)
- C = math_Mandel66to3333(constitutive_homogenizedC(ipc,ip,el))
+ C = math_66toSym3333(constitutive_homogenizedC(ipc,ip,el))
 
  DegradationLoop: do d = 1_pInt, phase_NstiffnessDegradations(material_phase(ipc,ip,el))
    degradationType: select case(phase_stiffnessDegradation(d,material_phase(ipc,ip,el)))
      case (STIFFNESS_DEGRADATION_damage_ID) degradationType
        C = C * damage(ho)%p(damageMapping(ho)%p(ip,el))**2_pInt
-     case (STIFFNESS_DEGRADATION_porosity_ID) degradationType
-       C = C * porosity(ho)%p(porosityMapping(ho)%p(ip,el))**2_pInt
    end select degradationType
  enddo DegradationLoop
 
@@ -835,8 +786,8 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
    debug_levelBasic
  use math, only: &
    math_mul33x33, &
-   math_Mandel6to33, &
+   math_6toSym33, &
-   math_Mandel33to6, &
+   math_sym33to6, &
    math_mul33x33
  use mesh, only: &
    mesh_NcpElems, &
@@ -905,18 +856,20 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
  integer(pInt) :: &
    ho, &                                                                                            !< homogenization
    tme, &                                                                                           !< thermal member position
-   s, &                                                                                                !< counter in source loop
+   s, &                                                                                             !< counter in source loop
    instance, of
 
  ho = material_homogenizationAt(el)
  tme = thermalMapping(ho)%p(ip,el)
 
- Mp  = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6))
+ Mp  = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6))
 
  plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
 
    case (PLASTICITY_ISOTROPIC_ID) plasticityType
-     call plastic_isotropic_dotState    (math_Mandel33to6(Mp),ipc,ip,el)
+     of = phasememberAt(ipc,ip,el)
+     instance = phase_plasticityInstance(material_phase(ipc,ip,el))
+     call plastic_isotropic_dotState    (Mp,instance,of)
 
    case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType
      of = phasememberAt(ipc,ip,el)
@@ -924,7 +877,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
      call plastic_phenopowerlaw_dotState(Mp,instance,of)
 
    case (PLASTICITY_KINEHARDENING_ID) plasticityType
-     call plastic_kinehardening_dotState(math_Mandel33to6(Mp),ipc,ip,el)
+     of = phasememberAt(ipc,ip,el)
+     instance = phase_plasticityInstance(material_phase(ipc,ip,el))
+     call plastic_kinehardening_dotState(Mp,instance,of)
 
    case (PLASTICITY_DISLOTWIN_ID) plasticityType
      of = phasememberAt(ipc,ip,el)
@@ -937,7 +892,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac
      call plastic_disloucla_dotState    (Mp,temperature(ho)%p(tme),instance,of)
 
    case (PLASTICITY_NONLOCAL_ID) plasticityType
-     call plastic_nonlocal_dotState     (math_Mandel33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), &
+     call plastic_nonlocal_dotState     (math_sym33to6(Mp),FeArray,FpArray,temperature(ho)%p(tme), &
                                          subdt,subfracArray,ip,el)
  end select plasticityType
 
@@ -967,7 +922,7 @@ end subroutine constitutive_collectDotState
 !> @brief for constitutive models having an instantaneous change of state
 !> will return false if delta state is not needed/supported by the constitutive model
 !--------------------------------------------------------------------------------------------------
-subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el)
+subroutine constitutive_collectDeltaState(S, Fe, Fi, ipc, ip, el)
  use prec, only: &
    pReal, &
    pLongInt
@@ -976,71 +931,62 @@ subroutine constitutive_collectDeltaState(S6, Fe, Fi, ipc, ip, el)
    debug_constitutive, &
    debug_levelBasic
  use math, only: &
-   math_Mandel6to33, &
+   math_sym33to6, &
-   math_Mandel33to6, &
    math_mul33x33
  use material, only: &
+   phasememberAt, &
+   phase_plasticityInstance, &
    phase_plasticity, &
    phase_source, &
    phase_Nsources, &
    material_phase, &
    PLASTICITY_KINEHARDENING_ID, &
    PLASTICITY_NONLOCAL_ID, &
-   SOURCE_damage_isoBrittle_ID, &
+   SOURCE_damage_isoBrittle_ID
-   SOURCE_vacancy_irradiation_ID, &
-   SOURCE_vacancy_thermalfluc_ID
  use plastic_kinehardening, only: &
    plastic_kinehardening_deltaState   
  use plastic_nonlocal, only: &
    plastic_nonlocal_deltaState
  use source_damage_isoBrittle, only: &
    source_damage_isoBrittle_deltaState
- use source_vacancy_irradiation, only: &
-   source_vacancy_irradiation_deltaState
- use source_vacancy_thermalfluc, only: &
-   source_vacancy_thermalfluc_deltaState
 
  implicit none
  integer(pInt), intent(in) :: &
    ipc, &                                                                                           !< component-ID of integration point
    ip, &                                                                                            !< integration point
    el                                                                                               !< element
- real(pReal),   intent(in),  dimension(6) :: &
-   S6                                                                                               !< 2nd Piola Kirchhoff stress (vector notation)
  real(pReal),   intent(in), dimension(3,3) :: &
+   S, &                                                                                             !< 2nd Piola Kirchhoff stress
    Fe, &                                                                                            !< elastic deformation gradient
    Fi                                                                                               !< intermediate deformation gradient
  real(pReal),               dimension(3,3) :: &
-   Mstar
+   Mp
  integer(pInt) :: &
-   s                                                                                                !< counter in source loop
+   i, &
+   instance, of
 
- Mstar  = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6))
+ Mp  = math_mul33x33(math_mul33x33(transpose(Fi),Fi),S)
 
  plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
 
    case (PLASTICITY_KINEHARDENING_ID) plasticityType
-     call plastic_kinehardening_deltaState(math_Mandel33to6(Mstar),ipc,ip,el)
+     of = phasememberAt(ipc,ip,el)
+     instance = phase_plasticityInstance(material_phase(ipc,ip,el))
+     call plastic_kinehardening_deltaState(Mp,instance,of)
 
    case (PLASTICITY_NONLOCAL_ID) plasticityType
-     call plastic_nonlocal_deltaState(math_Mandel33to6(Mstar),ip,el)
+     call plastic_nonlocal_deltaState(math_sym33to6(Mp),ip,el)
 
  end select plasticityType
 
- sourceLoop: do s = 1_pInt, phase_Nsources(material_phase(ipc,ip,el))
+ sourceLoop: do i = 1_pInt, phase_Nsources(material_phase(ipc,ip,el))
 
-    sourceType: select case (phase_source(s,material_phase(ipc,ip,el)))
+    sourceType: select case (phase_source(i,material_phase(ipc,ip,el)))
 
      case (SOURCE_damage_isoBrittle_ID) sourceType
        call source_damage_isoBrittle_deltaState  (constitutive_homogenizedC(ipc,ip,el), Fe, &
                                                   ipc, ip, el)
 
-     case (SOURCE_vacancy_irradiation_ID) sourceType
-       call source_vacancy_irradiation_deltaState(ipc, ip, el)
-
-     case (SOURCE_vacancy_thermalfluc_ID) sourceType
-       call source_vacancy_thermalfluc_deltaState(ipc, ip, el)
-
    end select sourceType
 
  enddo SourceLoop
@@ -1055,7 +1001,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
  use prec, only: &
    pReal
  use math, only: &
-  math_Mandel6to33, &
+  math_6toSym33, &
   math_mul33x33
  use mesh, only: &
    mesh_NcpElems, &
@@ -1130,7 +1076,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
 
  constitutive_postResults = 0.0_pReal
 
- Mp  = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_Mandel6to33(S6))
+ Mp  = math_mul33x33(math_mul33x33(transpose(Fi),Fi),math_6toSym33(S6))
 
  ho = material_homogenizationAt(el)
  tme = thermalMapping(ho)%p(ip,el)
@@ -1140,8 +1086,10 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
 
  plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el)))
    case (PLASTICITY_ISOTROPIC_ID) plasticityType
+     of = phasememberAt(ipc,ip,el)
+     instance = phase_plasticityInstance(material_phase(ipc,ip,el))
      constitutive_postResults(startPos:endPos) = &
-       plastic_isotropic_postResults(S6,ipc,ip,el)
+       plastic_isotropic_postResults(Mp,instance,of)
 
    case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType
      of = phasememberAt(ipc,ip,el)
@@ -1150,8 +1098,10 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
        plastic_phenopowerlaw_postResults(Mp,instance,of)
 
    case (PLASTICITY_KINEHARDENING_ID) plasticityType
+     of = phasememberAt(ipc,ip,el)
+     instance = phase_plasticityInstance(material_phase(ipc,ip,el))
      constitutive_postResults(startPos:endPos) = &
-       plastic_kinehardening_postResults(S6,ipc,ip,el)
+       plastic_kinehardening_postResults(Mp,instance,of)
 
    case (PLASTICITY_DISLOTWIN_ID) plasticityType
      of = phasememberAt(ipc,ip,el)
@@ -1189,4 +1139,43 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el)
 
 end function constitutive_postResults
 
+
+!--------------------------------------------------------------------------------------------------
+!> @brief writes constitutive results to HDF5 output file
+!--------------------------------------------------------------------------------------------------
+subroutine constitutive_results()
+ use material, only: &
+   PLASTICITY_ISOTROPIC_ID, &
+   PLASTICITY_PHENOPOWERLAW_ID, &
+   PLASTICITY_KINEHARDENING_ID, &
+   PLASTICITY_DISLOTWIN_ID, &
+   PLASTICITY_DISLOUCLA_ID, &
+   PLASTICITY_NONLOCAL_ID
+#if defined(PETSc) || defined(DAMASKHDF5)
+ use results
+ use HDF5_utilities
+ use config, only: &
+   config_name_phase => phase_name                                                                  ! anticipate logical name
+   
+ use material, only: &
+   phase_plasticityInstance, &
+   material_phase_plasticity_type => phase_plasticity
+ use plastic_phenopowerlaw, only: &
+   plastic_phenopowerlaw_results
+ 
+ implicit none
+ integer(pInt) :: p  
+ call HDF5_closeGroup(results_addGroup('current/phase'))                                              
+ do p=1,size(config_name_phase)                                                                           
+   call HDF5_closeGroup(results_addGroup('current/phase/'//trim(config_name_phase(p))))
+   if (material_phase_plasticity_type(p) == PLASTICITY_PHENOPOWERLAW_ID) then
+     call plastic_phenopowerlaw_results(phase_plasticityInstance(p),'current/phase/'//trim(config_name_phase(p)))
+   endif
+ enddo      
+
+#endif
+
+
+end subroutine constitutive_results
+
 end module constitutive

src/homogenization.f90

@@ -25,10 +25,7 @@ module homogenization
    materialpoint_sizeResults, &
    homogenization_maxSizePostResults, &
    thermal_maxSizePostResults, &
-   damage_maxSizePostResults, &
+   damage_maxSizePostResults
-   vacancyflux_maxSizePostResults, &
-   porosity_maxSizePostResults, &
-   hydrogenflux_maxSizePostResults
 
  real(pReal),   dimension(:,:,:,:),     allocatable, private :: &
    materialpoint_subF0, &                                                                           !< def grad of IP at beginning of homogenization increment
@@ -48,10 +45,10 @@ module homogenization
    materialpoint_stressAndItsTangent, &
    materialpoint_postResults
  private :: &
-   homogenization_partitionDeformation, &
+   partitionDeformation, &
-   homogenization_updateState, &
+   updateState, &
-   homogenization_averageStressAndItsTangent, &
+   averageStressAndItsTangent, &
-   homogenization_postResults
+   postResults
 
 contains
 
@@ -100,13 +97,6 @@ subroutine homogenization_init
  use damage_none
  use damage_local
  use damage_nonlocal
- use vacancyflux_isoconc
- use vacancyflux_isochempot
- use vacancyflux_cahnhilliard
- use porosity_none
- use porosity_phasefield
- use hydrogenflux_isoconc
- use hydrogenflux_cahnhilliard
  use IO
  use numerics, only: &
    worldrank
@@ -128,12 +118,9 @@ subroutine homogenization_init
 
 !--------------------------------------------------------------------------------------------------
 ! parse homogenization from config file 
- if (any(homogenization_type == HOMOGENIZATION_NONE_ID)) &
+ if (any(homogenization_type == HOMOGENIZATION_NONE_ID))      call homogenization_none_init
-   call homogenization_none_init()
+ if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call homogenization_isostrain_init
- if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) &
+ if (any(homogenization_type == HOMOGENIZATION_RGC_ID))       call homogenization_RGC_init
-   call homogenization_isostrain_init(FILEUNIT)
- if (any(homogenization_type == HOMOGENIZATION_RGC_ID)) &
-   call homogenization_RGC_init(FILEUNIT)
 
 !--------------------------------------------------------------------------------------------------
 ! parse thermal from config file
@@ -155,33 +142,6 @@ subroutine homogenization_init
  if (any(damage_type == DAMAGE_nonlocal_ID)) &
    call damage_nonlocal_init(FILEUNIT)
 
-!--------------------------------------------------------------------------------------------------
-! parse vacancy transport from config file
- call IO_checkAndRewind(FILEUNIT)
- if (any(vacancyflux_type == VACANCYFLUX_isoconc_ID)) &
-   call vacancyflux_isoconc_init()
- if (any(vacancyflux_type == VACANCYFLUX_isochempot_ID)) &
-   call vacancyflux_isochempot_init(FILEUNIT)
- if (any(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID)) &
-   call vacancyflux_cahnhilliard_init(FILEUNIT)
-
-!--------------------------------------------------------------------------------------------------
-! parse porosity from config file
- call IO_checkAndRewind(FILEUNIT)
- if (any(porosity_type == POROSITY_none_ID)) &
-   call porosity_none_init()
- if (any(porosity_type == POROSITY_phasefield_ID)) &
-   call porosity_phasefield_init(FILEUNIT)
-
-!--------------------------------------------------------------------------------------------------
-! parse hydrogen transport from config file
- call IO_checkAndRewind(FILEUNIT)
- if (any(hydrogenflux_type == HYDROGENFLUX_isoconc_ID)) &
-   call hydrogenflux_isoconc_init()
- if (any(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID)) &
-   call hydrogenflux_cahnhilliard_init(FILEUNIT)
- close(FILEUNIT)
-
 !--------------------------------------------------------------------------------------------------
 ! write description file for homogenization output
  mainProcess2: if (worldrank == 0) then
@@ -193,17 +153,14 @@ subroutine homogenization_init
        select case(homogenization_type(p))                                                              ! split per homogenization type
          case (HOMOGENIZATION_NONE_ID)
            outputName = HOMOGENIZATION_NONE_label
-           thisNoutput => null()
            thisOutput => null()
            thisSize   => null()
          case (HOMOGENIZATION_ISOSTRAIN_ID)
            outputName = HOMOGENIZATION_ISOSTRAIN_label
-           thisNoutput => homogenization_isostrain_Noutput
+           thisOutput => null()
-           thisOutput => homogenization_isostrain_output
+           thisSize   => null()
-           thisSize   => homogenization_isostrain_sizePostResult
          case (HOMOGENIZATION_RGC_ID)
            outputName = HOMOGENIZATION_RGC_label
-           thisNoutput => homogenization_RGC_Noutput
            thisOutput => homogenization_RGC_output
            thisSize   => homogenization_RGC_sizePostResult
          case default
@@ -213,8 +170,9 @@ subroutine homogenization_init
        if (valid) then
          write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName)
          write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p)
-         if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID) then
+         if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID .and. &
-           do e = 1,thisNoutput(i)
+             homogenization_type(p) /= HOMOGENIZATION_ISOSTRAIN_ID) then
+           do e = 1,size(thisOutput(:,i))
              write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
            enddo
          endif
@@ -277,83 +235,6 @@ subroutine homogenization_init
            enddo
          endif
        endif
-       i = vacancyflux_typeInstance(p)                                                                  ! which instance of this vacancy flux type
-       valid = .true.                                                                                   ! assume valid
-       select case(vacancyflux_type(p))                                                                 ! split per vacancy flux type
-         case (VACANCYFLUX_isoconc_ID)
-           outputName = VACANCYFLUX_isoconc_label
-           thisNoutput => null()
-           thisOutput => null()
-           thisSize   => null()
-         case (VACANCYFLUX_isochempot_ID)
-           outputName = VACANCYFLUX_isochempot_label
-           thisNoutput => vacancyflux_isochempot_Noutput
-           thisOutput => vacancyflux_isochempot_output
-           thisSize   => vacancyflux_isochempot_sizePostResult
-         case (VACANCYFLUX_cahnhilliard_ID)
-           outputName = VACANCYFLUX_cahnhilliard_label
-           thisNoutput => vacancyflux_cahnhilliard_Noutput
-           thisOutput => vacancyflux_cahnhilliard_output
-           thisSize   => vacancyflux_cahnhilliard_sizePostResult
-         case default
-           valid = .false.
-       end select
-       if (valid) then
-         write(FILEUNIT,'(a)') '(vacancyflux)'//char(9)//trim(outputName)
-         if (vacancyflux_type(p) /= VACANCYFLUX_isoconc_ID) then
-           do e = 1,thisNoutput(i)
-             write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
-           enddo
-         endif
-       endif
-       i = porosity_typeInstance(p)                                                                     ! which instance of this porosity type
-       valid = .true.                                                                                   ! assume valid
-       select case(porosity_type(p))                                                                    ! split per porosity type
-         case (POROSITY_none_ID)
-           outputName = POROSITY_none_label
-           thisNoutput => null()
-           thisOutput => null()
-           thisSize   => null()
-         case (POROSITY_phasefield_ID)
-           outputName = POROSITY_phasefield_label
-           thisNoutput => porosity_phasefield_Noutput
-           thisOutput => porosity_phasefield_output
-           thisSize   => porosity_phasefield_sizePostResult
-         case default
-           valid = .false.
-       end select
-       if (valid) then
-         write(FILEUNIT,'(a)') '(porosity)'//char(9)//trim(outputName)
-         if (porosity_type(p) /= POROSITY_none_ID) then
-           do e = 1,thisNoutput(i)
-             write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
-           enddo
-         endif
-       endif
-       i = hydrogenflux_typeInstance(p)                                                                 ! which instance of this hydrogen flux type
-       valid = .true.                                                                                   ! assume valid
-       select case(hydrogenflux_type(p))                                                                ! split per hydrogen flux type
-         case (HYDROGENFLUX_isoconc_ID)
-           outputName = HYDROGENFLUX_isoconc_label
-           thisNoutput => null()
-           thisOutput => null()
-           thisSize   => null()
-         case (HYDROGENFLUX_cahnhilliard_ID)
-           outputName = HYDROGENFLUX_cahnhilliard_label
-           thisNoutput => hydrogenflux_cahnhilliard_Noutput
-           thisOutput => hydrogenflux_cahnhilliard_output
-           thisSize   => hydrogenflux_cahnhilliard_sizePostResult
-         case default
-           valid = .false.
-       end select
-       if (valid) then
-         write(FILEUNIT,'(a)') '(hydrogenflux)'//char(9)//trim(outputName)
-         if (hydrogenflux_type(p) /= HYDROGENFLUX_isoconc_ID) then
-           do e = 1,thisNoutput(i)
-             write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
-           enddo
-         endif
-       endif
      endif
    enddo
    close(FILEUNIT)
@@ -383,25 +264,16 @@ subroutine homogenization_init
  homogenization_maxSizePostResults = 0_pInt
  thermal_maxSizePostResults        = 0_pInt
  damage_maxSizePostResults         = 0_pInt
- vacancyflux_maxSizePostResults    = 0_pInt
- porosity_maxSizePostResults       = 0_pInt
- hydrogenflux_maxSizePostResults   = 0_pInt
  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)
-   vacancyflux_maxSizePostResults    = max(vacancyflux_maxSizePostResults   ,vacancyfluxState (p)%sizePostResults)
-   porosity_maxSizePostResults       = max(porosity_maxSizePostResults      ,porosityState    (p)%sizePostResults)
-   hydrogenflux_maxSizePostResults   = max(hydrogenflux_maxSizePostResults  ,hydrogenfluxState(p)%sizePostResults)
  enddo
 
  materialpoint_sizeResults = 1 &                                                                    ! grain count
                            + 1 + homogenization_maxSizePostResults &                                ! homogSize & homogResult
                                + thermal_maxSizePostResults        &
                                + damage_maxSizePostResults         &
-                               + vacancyflux_maxSizePostResults    &
-                               + porosity_maxSizePostResults       &
-                               + hydrogenflux_maxSizePostResults   &
                            + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults &      ! crystallite size & crystallite results
                                                         + 1 + constitutive_plasticity_maxSizePostResults &     ! constitutive size & constitutive results
                                                             + constitutive_source_maxSizePostResults)
@@ -460,9 +332,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
    homogState, &
    thermalState, &
    damageState, &
-   vacancyfluxState, &
-   porosityState, &
-   hydrogenfluxState, &
    phase_Nsources, &
    mappingHomogenization, &
    phaseAt, phasememberAt, &
@@ -478,7 +347,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
    crystallite_Li0, &
    crystallite_Li, &
    crystallite_dPdF, &
-   crystallite_dPdF0, &
    crystallite_Tstar0_v, &
    crystallite_Tstar_v, &
    crystallite_partionedF0, &
@@ -487,12 +355,11 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
    crystallite_partionedLp0, &
    crystallite_partionedFi0, &
    crystallite_partionedLi0, &
-   crystallite_partioneddPdF0, &
    crystallite_partionedTstar0_v, &
    crystallite_dt, &
    crystallite_requested, &
-   crystallite_converged, &
+   crystallite_stress, &
-   crystallite_stressAndItsTangent, &
+   crystallite_stressTangent, &
    crystallite_orientations
 #ifdef DEBUG
  use debug, only: &
@@ -545,7 +412,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
      crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e)                       ! ...plastic velocity grads
      crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e)                       ! ...intermediate def grads
      crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e)                       ! ...intermediate velocity grads
-     crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,g,i,e) = crystallite_dPdF0(1:3,1:3,1:3,1:3,g,i,e)   ! ...stiffness
      crystallite_partionedF0(1:3,1:3,g,i,e) = crystallite_F0(1:3,1:3,g,i,e)                         ! ...def grads
      crystallite_partionedTstar0_v(1:6,g,i,e) = crystallite_Tstar0_v(1:6,g,i,e)                     ! ...2nd PK stress
 
@@ -569,18 +435,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
      damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
        damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
        damageState(mappingHomogenization(2,i,e))%State0(   :,mappingHomogenization(1,i,e))          ! ...internal damage state
-   forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
-     vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
-       vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
-       vacancyfluxState(mappingHomogenization(2,i,e))%State0(   :,mappingHomogenization(1,i,e))     ! ...internal vacancy transport state
-   forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
-     porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
-       porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
-       porosityState(mappingHomogenization(2,i,e))%State0(   :,mappingHomogenization(1,i,e))        ! ...internal porosity state
-   forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
-     hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
-       hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
-       hydrogenfluxState(mappingHomogenization(2,i,e))%State0(   :,mappingHomogenization(1,i,e))    ! ...internal hydrogen transport state
  enddo
  NiterationHomog = 0_pInt
 
@@ -627,9 +481,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
            crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) = &
              crystallite_Li(1:3,1:3,1:myNgrains,i,e)                                                ! ...intermediate velocity grads
 
-           crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e)                                      ! ...stiffness
-
            crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e) = &
              crystallite_Tstar_v(1:6,1:myNgrains,i,e)                                               ! ...2nd PK stress
 
@@ -654,18 +505,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
              damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
                damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
                damageState(mappingHomogenization(2,i,e))%State(    :,mappingHomogenization(1,i,e))  ! ...internal damage state
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
-             vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
-               vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
-               vacancyfluxState(mappingHomogenization(2,i,e))%State(    :,mappingHomogenization(1,i,e))! ...internal vacancy transport state
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
-             porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
-               porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
-               porosityState(mappingHomogenization(2,i,e))%State(    :,mappingHomogenization(1,i,e))! ...internal porosity state
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
-             hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
-               hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e)) = &
-               hydrogenfluxState(mappingHomogenization(2,i,e))%State(    :,mappingHomogenization(1,i,e))! ...internal hydrogen transport state
            materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e)                       ! ...def grad
          endif steppingNeeded
 
@@ -705,8 +544,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
              crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e)                                      ! ...intermediate def grads
            crystallite_Li(1:3,1:3,1:myNgrains,i,e) = &
              crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e)                                      ! ...intermediate velocity grads
-           crystallite_dPdF(1:3,1:3,1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_partioneddPdF0(1:3,1:3,1:3,1:3,1:myNgrains,i,e)                            ! ...stiffness
            crystallite_Tstar_v(1:6,1:myNgrains,i,e) = &
               crystallite_partionedTstar0_v(1:6,1:myNgrains,i,e)                                    ! ...2nd PK stress
            do g = 1, myNgrains
@@ -729,18 +566,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
              damageState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
                damageState(mappingHomogenization(2,i,e))%State(    :,mappingHomogenization(1,i,e)) = &
                damageState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))  ! ...internal damage state
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
-             vacancyfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
-               vacancyfluxState(mappingHomogenization(2,i,e))%State(    :,mappingHomogenization(1,i,e)) = &
-               vacancyfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal vacancy transport state
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
-             porosityState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
-               porosityState(mappingHomogenization(2,i,e))%State(    :,mappingHomogenization(1,i,e)) = &
-               porosityState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal porosity state
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
-             hydrogenfluxState(mappingHomogenization(2,i,e))%sizeState > 0_pInt) &
-               hydrogenfluxState(mappingHomogenization(2,i,e))%State(    :,mappingHomogenization(1,i,e)) = &
-               hydrogenfluxState(mappingHomogenization(2,i,e))%subState0(:,mappingHomogenization(1,i,e))! ...internal hydrogen transport state
          endif
        endif converged
 
@@ -775,7 +600,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
        IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
          if (      materialpoint_requested(i,e) .and. &                                             ! process requested but...
              .not. materialpoint_doneAndHappy(1,i,e)) then                                          ! ...not yet done material points
-           call homogenization_partitionDeformation(i,e)                                            ! partition deformation onto constituents
+           call partitionDeformation(i,e)                                            ! partition deformation onto constituents
            crystallite_dt(1:myNgrains,i,e) = materialpoint_subdt(i,e)                               ! propagate materialpoint dt to grains
            crystallite_requested(1:myNgrains,i,e) = .true.                                          ! request calculation for constituents
          else
@@ -789,7 +614,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
 ! crystallite integration
 ! based on crystallite_partionedF0,.._partionedF
 ! incrementing by crystallite_dt
-     call crystallite_stressAndItsTangent(updateJaco)                                                ! request stress and tangent calculation for constituent grains
+     materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic
 
 !--------------------------------------------------------------------------------------------------
 ! state update
@@ -798,11 +623,10 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
        IpLooping3: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
          if (      materialpoint_requested(i,e) .and. &
              .not. materialpoint_doneAndHappy(1,i,e)) then
-           if (.not. all(crystallite_converged(:,i,e))) then
+           if (.not. materialpoint_converged(i,e)) then
              materialpoint_doneAndHappy(1:2,i,e) = [.true.,.false.]
-             materialpoint_converged(i,e) = .false.
            else
-             materialpoint_doneAndHappy(1:2,i,e) = homogenization_updateState(i,e)
+             materialpoint_doneAndHappy(1:2,i,e) = updateState(i,e)
              materialpoint_converged(i,e) = all(materialpoint_doneAndHappy(1:2,i,e))                  ! converged if done and happy
            endif
          endif
@@ -816,12 +640,14 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
 
  enddo cutBackLooping
  
+ if(updateJaco) call crystallite_stressTangent
+
  if (.not. terminallyIll ) then
    call crystallite_orientations()                                                                  ! calculate crystal orientations
    !$OMP PARALLEL DO
    elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2)
      IpLooping4: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
-       call homogenization_averageStressAndItsTangent(i,e)
+       call averageStressAndItsTangent(i,e)
      enddo IpLooping4
    enddo elementLooping4
    !$OMP END PARALLEL DO
@@ -846,9 +672,6 @@ subroutine materialpoint_postResults
    homogState, &
    thermalState, &
    damageState, &
-   vacancyfluxState, &
-   porosityState, &
-   hydrogenfluxState, &
    plasticState, &
    sourceState, &
    material_phase, &
@@ -877,15 +700,12 @@ subroutine materialpoint_postResults
 
        theSize = homogState       (mappingHomogenization(2,i,e))%sizePostResults &
                + thermalState     (mappingHomogenization(2,i,e))%sizePostResults &
-               + damageState      (mappingHomogenization(2,i,e))%sizePostResults &
+               + damageState      (mappingHomogenization(2,i,e))%sizePostResults
-               + vacancyfluxState (mappingHomogenization(2,i,e))%sizePostResults &
-               + porosityState    (mappingHomogenization(2,i,e))%sizePostResults &
-               + hydrogenfluxState(mappingHomogenization(2,i,e))%sizePostResults
        materialpoint_results(thePos+1,i,e) = real(theSize,pReal)                                    ! tell size of homogenization results
        thePos = thePos + 1_pInt
 
        if (theSize > 0_pInt) then                                                                   ! any homogenization results to mention?
-         materialpoint_results(thePos+1:thePos+theSize,i,e) = homogenization_postResults(i,e)       ! tell homogenization results
+         materialpoint_results(thePos+1:thePos+theSize,i,e) = postResults(i,e)       ! tell homogenization results
          thePos = thePos + theSize
        endif
 
@@ -909,12 +729,12 @@ end subroutine materialpoint_postResults
 !--------------------------------------------------------------------------------------------------
 !> @brief  partition material point def grad onto constituents
 !--------------------------------------------------------------------------------------------------
-subroutine homogenization_partitionDeformation(ip,el)
+subroutine partitionDeformation(ip,el)
  use mesh, only: &
    mesh_element
  use material, only: &
    homogenization_type, &
-   homogenization_maxNgrains, &
+   homogenization_Ngrains, &
    HOMOGENIZATION_NONE_ID, &
    HOMOGENIZATION_ISOSTRAIN_ID, &
    HOMOGENIZATION_RGC_ID
@@ -933,43 +753,39 @@ subroutine homogenization_partitionDeformation(ip,el)
  chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
 
    case (HOMOGENIZATION_NONE_ID) chosenHomogenization
-     crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el) = 0.0_pReal
+     crystallite_partionedF(1:3,1:3,1,ip,el) = materialpoint_subF(1:3,1:3,ip,el)
-     crystallite_partionedF(1:3,1:3,1:1,ip,el) = &
-       spread(materialpoint_subF(1:3,1:3,ip,el),3,1)
 
    case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
      call homogenization_isostrain_partitionDeformation(&
-                          crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
+                          crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-                          materialpoint_subF(1:3,1:3,ip,el),&
+                          materialpoint_subF(1:3,1:3,ip,el))
-                          el)
+
    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
      call homogenization_RGC_partitionDeformation(&
-                         crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
+                         crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
                          materialpoint_subF(1:3,1:3,ip,el),&
                          ip, &
                          el)
  end select chosenHomogenization
 
-end subroutine homogenization_partitionDeformation
+end subroutine partitionDeformation
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief update the internal state of the homogenization scheme and tell whether "done" and
 !> "happy" with result
 !--------------------------------------------------------------------------------------------------
-function homogenization_updateState(ip,el)
+function updateState(ip,el)
  use mesh, only: &
    mesh_element
  use material, only: &
    homogenization_type, &
    thermal_type, &
    damage_type, &
-   vacancyflux_type, &
+   homogenization_Ngrains, &
-   homogenization_maxNgrains, &
    HOMOGENIZATION_RGC_ID, &
    THERMAL_adiabatic_ID, &
-   DAMAGE_local_ID, &
+   DAMAGE_local_ID
-   VACANCYFLUX_isochempot_ID
  use crystallite, only: &
    crystallite_P, &
    crystallite_dPdF, &
@@ -981,34 +797,32 @@ function homogenization_updateState(ip,el)
    thermal_adiabatic_updateState
  use damage_local, only: &
    damage_local_updateState
- use vacancyflux_isochempot, only: &
-   vacancyflux_isochempot_updateState
 
  implicit none
  integer(pInt), intent(in) :: &
    ip, &                                                                                            !< integration point
    el                                                                                               !< element number
- logical, dimension(2) :: homogenization_updateState
+ logical, dimension(2) :: updateState
 
- homogenization_updateState = .true.
+ updateState = .true.
  chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
-     homogenization_updateState = &
+     updateState = &
-       homogenization_updateState .and. &
+       updateState .and. &
-        homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
+        homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-                                       crystallite_partionedF(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
+                                       crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-                                       crystallite_partionedF0(1:3,1:3,1:homogenization_maxNgrains,ip,el),&
+                                       crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),&
                                        materialpoint_subF(1:3,1:3,ip,el),&
                                        materialpoint_subdt(ip,el), &
-                                       crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), &
+                                       crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
                                        ip, &
                                        el)
  end select chosenHomogenization
 
  chosenThermal: select case (thermal_type(mesh_element(3,el)))
    case (THERMAL_adiabatic_ID) chosenThermal
-     homogenization_updateState = &
+     updateState = &
-       homogenization_updateState .and. &
+       updateState .and. &
        thermal_adiabatic_updateState(materialpoint_subdt(ip,el), &
                                      ip, &
                                      el)
@@ -1016,34 +830,26 @@ function homogenization_updateState(ip,el)
 
  chosenDamage: select case (damage_type(mesh_element(3,el)))
    case (DAMAGE_local_ID) chosenDamage
-     homogenization_updateState = &
+     updateState = &
-       homogenization_updateState .and. &
+       updateState .and. &
        damage_local_updateState(materialpoint_subdt(ip,el), &
                                 ip, &
                                 el)
  end select chosenDamage
 
- chosenVacancyflux: select case (vacancyflux_type(mesh_element(3,el)))
+end function updateState
-   case (VACANCYFLUX_isochempot_ID) chosenVacancyflux
-     homogenization_updateState = &
-       homogenization_updateState .and. &
-       vacancyflux_isochempot_updateState(materialpoint_subdt(ip,el), &
-                                          ip, &
-                                          el)
- end select chosenVacancyflux
-
-end function homogenization_updateState
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief derive average stress and stiffness from constituent quantities
 !--------------------------------------------------------------------------------------------------
-subroutine homogenization_averageStressAndItsTangent(ip,el)
+subroutine averageStressAndItsTangent(ip,el)
  use mesh, only: &
    mesh_element
  use material, only: &
    homogenization_type, &
-   homogenization_maxNgrains, &
+   homogenization_typeInstance, &
+   homogenization_Ngrains, &
    HOMOGENIZATION_NONE_ID, &
    HOMOGENIZATION_ISOSTRAIN_ID, &
    HOMOGENIZATION_RGC_ID
@@ -1061,49 +867,46 @@ subroutine homogenization_averageStressAndItsTangent(ip,el)
 
  chosenHomogenization: select case(homogenization_type(mesh_element(3,el)))
    case (HOMOGENIZATION_NONE_ID) chosenHomogenization
-       materialpoint_P(1:3,1:3,ip,el) = sum(crystallite_P(1:3,1:3,1:1,ip,el),3)
+       materialpoint_P(1:3,1:3,ip,el)            = crystallite_P(1:3,1:3,1,ip,el)
-       materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el) &
+       materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el) = crystallite_dPdF(1:3,1:3,1:3,1:3,1,ip,el)
-        = sum(crystallite_dPdF(1:3,1:3,1:3,1:3,1:1,ip,el),5)
 
    case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
      call homogenization_isostrain_averageStressAndItsTangent(&
        materialpoint_P(1:3,1:3,ip,el), &
        materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
-       crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
+       crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-       crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), &
+       crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-       el)
+       homogenization_typeInstance(mesh_element(3,el)))
+
    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
      call homogenization_RGC_averageStressAndItsTangent(&
        materialpoint_P(1:3,1:3,ip,el), &
        materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
-       crystallite_P(1:3,1:3,1:homogenization_maxNgrains,ip,el), &
+       crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-       crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_maxNgrains,ip,el), &
+       crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-       el)
+       homogenization_typeInstance(mesh_element(3,el)))
  end select chosenHomogenization
 
-end subroutine homogenization_averageStressAndItsTangent
+end subroutine averageStressAndItsTangent
+
 
 !--------------------------------------------------------------------------------------------------
 !> @brief return array of homogenization results for post file inclusion. call only,
 !> if homogenization_sizePostResults(i,e) > 0 !!
 !--------------------------------------------------------------------------------------------------
-function homogenization_postResults(ip,el)
+function postResults(ip,el)
  use mesh, only: &
    mesh_element
  use material, only: &
+   material_homogenizationAt, &
+   homogenization_typeInstance,&
    mappingHomogenization, &
    homogState, &
    thermalState, &
    damageState, &
-   vacancyfluxState, &
-   porosityState, &
-   hydrogenfluxState, &
    homogenization_type, &
    thermal_type, &
    damage_type, &
-   vacancyflux_type, &
-   porosity_type, &
-   hydrogenflux_type, &
    HOMOGENIZATION_NONE_ID, &
    HOMOGENIZATION_ISOSTRAIN_ID, &
    HOMOGENIZATION_RGC_ID, &
@@ -1112,16 +915,7 @@ function homogenization_postResults(ip,el)
    THERMAL_conduction_ID, &
    DAMAGE_none_ID, &
    DAMAGE_local_ID, &
-   DAMAGE_nonlocal_ID, &
+   DAMAGE_nonlocal_ID
-   VACANCYFLUX_isoconc_ID, &
-   VACANCYFLUX_isochempot_ID, &
-   VACANCYFLUX_cahnhilliard_ID, &
-   POROSITY_none_ID, &
-   POROSITY_phasefield_ID, &
-   HYDROGENFLUX_isoconc_ID, &
-   HYDROGENFLUX_cahnhilliard_ID
- use homogenization_isostrain, only: &
-   homogenization_isostrain_postResults
  use homogenization_RGC, only: &
    homogenization_RGC_postResults
  use thermal_adiabatic, only: &
@@ -1132,14 +926,6 @@ function homogenization_postResults(ip,el)
    damage_local_postResults
  use damage_nonlocal, only: &
    damage_nonlocal_postResults
- use vacancyflux_isochempot, only: &
-   vacancyflux_isochempot_postResults
- use vacancyflux_cahnhilliard, only: &
-   vacancyflux_cahnhilliard_postResults
- use porosity_phasefield, only: &
-   porosity_phasefield_postResults
- use hydrogenflux_cahnhilliard, only: &
-   hydrogenflux_cahnhilliard_postResults
 
  implicit none
  integer(pInt), intent(in) :: &
@@ -1147,97 +933,47 @@ function homogenization_postResults(ip,el)
    el                                                                                               !< element number
  real(pReal), dimension(  homogState       (mappingHomogenization(2,ip,el))%sizePostResults &
                         + thermalState     (mappingHomogenization(2,ip,el))%sizePostResults &
-                        + damageState      (mappingHomogenization(2,ip,el))%sizePostResults &
+                        + damageState      (mappingHomogenization(2,ip,el))%sizePostResults) :: &
-                        + vacancyfluxState (mappingHomogenization(2,ip,el))%sizePostResults &
+   postResults
-                        + porosityState    (mappingHomogenization(2,ip,el))%sizePostResults &
-                        + hydrogenfluxState(mappingHomogenization(2,ip,el))%sizePostResults) :: &
-   homogenization_postResults
  integer(pInt) :: &
-   startPos, endPos
+   startPos, endPos ,&
+   of, instance
 
- homogenization_postResults = 0.0_pReal
 
+ postResults = 0.0_pReal
  startPos = 1_pInt
  endPos   = homogState(mappingHomogenization(2,ip,el))%sizePostResults
  chosenHomogenization: select case (homogenization_type(mesh_element(3,el)))
-   case (HOMOGENIZATION_NONE_ID) chosenHomogenization
 
-   case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
-     homogenization_postResults(startPos:endPos) = &
-       homogenization_isostrain_postResults(&
-                                  ip, &
-                                  el, &
-                                  materialpoint_P(1:3,1:3,ip,el), &
-                                  materialpoint_F(1:3,1:3,ip,el))
    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
-     homogenization_postResults(startPos:endPos) = &
+     instance = homogenization_typeInstance(material_homogenizationAt(el))
-       homogenization_RGC_postResults(&
+     of = mappingHomogenization(1,ip,el)
-                                  ip, &
+     postResults(startPos:endPos) = homogenization_RGC_postResults(instance,of)
-                                  el, &
+     
-                                  materialpoint_P(1:3,1:3,ip,el), &
-                                  materialpoint_F(1:3,1:3,ip,el))
  end select chosenHomogenization
 
  startPos = endPos + 1_pInt
  endPos   = endPos + thermalState(mappingHomogenization(2,ip,el))%sizePostResults
  chosenThermal: select case (thermal_type(mesh_element(3,el)))
-   case (THERMAL_isothermal_ID) chosenThermal
 
    case (THERMAL_adiabatic_ID) chosenThermal
-     homogenization_postResults(startPos:endPos) = &
+     postResults(startPos:endPos) = thermal_adiabatic_postResults(ip, el)
-       thermal_adiabatic_postResults(ip, el)
    case (THERMAL_conduction_ID) chosenThermal
-     homogenization_postResults(startPos:endPos) = &
+     postResults(startPos:endPos) =  thermal_conduction_postResults(ip, el)
-       thermal_conduction_postResults(ip, el)
+     
  end select chosenThermal
 
  startPos = endPos + 1_pInt
  endPos   = endPos + damageState(mappingHomogenization(2,ip,el))%sizePostResults
  chosenDamage: select case (damage_type(mesh_element(3,el)))
-   case (DAMAGE_none_ID) chosenDamage
 
    case (DAMAGE_local_ID) chosenDamage
-     homogenization_postResults(startPos:endPos) = &
+     postResults(startPos:endPos) = damage_local_postResults(ip, el)
-       damage_local_postResults(ip, el)
-
    case (DAMAGE_nonlocal_ID) chosenDamage
-     homogenization_postResults(startPos:endPos) = &
+     postResults(startPos:endPos) = damage_nonlocal_postResults(ip, el)
-       damage_nonlocal_postResults(ip, el)
+     
  end select chosenDamage
 
- startPos = endPos + 1_pInt
+end function postResults
- endPos   = endPos + vacancyfluxState(mappingHomogenization(2,ip,el))%sizePostResults
- chosenVacancyflux: select case (vacancyflux_type(mesh_element(3,el)))
-   case (VACANCYFLUX_isoconc_ID) chosenVacancyflux
-
-   case (VACANCYFLUX_isochempot_ID) chosenVacancyflux
-     homogenization_postResults(startPos:endPos) = &
-       vacancyflux_isochempot_postResults(ip, el)
-   case (VACANCYFLUX_cahnhilliard_ID) chosenVacancyflux
-     homogenization_postResults(startPos:endPos) = &
-       vacancyflux_cahnhilliard_postResults(ip, el)
- end select chosenVacancyflux
-
- startPos = endPos + 1_pInt
- endPos   = endPos + porosityState(mappingHomogenization(2,ip,el))%sizePostResults
- chosenPorosity: select case (porosity_type(mesh_element(3,el)))
-   case (POROSITY_none_ID) chosenPorosity
-
-   case (POROSITY_phasefield_ID) chosenPorosity
-     homogenization_postResults(startPos:endPos) = &
-       porosity_phasefield_postResults(ip, el)
- end select chosenPorosity
-
- startPos = endPos + 1_pInt
- endPos   = endPos + hydrogenfluxState(mappingHomogenization(2,ip,el))%sizePostResults
- chosenHydrogenflux: select case (hydrogenflux_type(mesh_element(3,el)))
-   case (HYDROGENFLUX_isoconc_ID) chosenHydrogenflux
-
-   case (HYDROGENFLUX_cahnhilliard_ID) chosenHydrogenflux
-     homogenization_postResults(startPos:endPos) = &
-       hydrogenflux_cahnhilliard_postResults(ip, el)
- end select chosenHydrogenflux
-
-end function homogenization_postResults
 
 end module homogenization

src/homogenization_isostrain.f90

@@ -1,4 +1,5 @@
 !--------------------------------------------------------------------------------------------------
+!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
 !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
 !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
 !> @brief Isostrain (full constraint Taylor assuption) homogenization scheme
@@ -9,217 +10,116 @@ module homogenization_isostrain
 
  implicit none
  private
- integer(pInt),               dimension(:),   allocatable,         public, protected :: &
-   homogenization_isostrain_sizePostResults
- integer(pInt),               dimension(:,:), allocatable, target, public :: &
-   homogenization_isostrain_sizePostResult
- 
- character(len=64),           dimension(:,:), allocatable, target, public :: &
-  homogenization_isostrain_output                                                                   !< name of each post result output
- integer(pInt),               dimension(:),   allocatable, target, public :: &
-   homogenization_isostrain_Noutput                                                                 !< number of outputs per homog instance
- integer(pInt),               dimension(:),   allocatable,         private :: &
-   homogenization_isostrain_Ngrains
  enum, bind(c) 
-   enumerator :: undefined_ID, &
+   enumerator :: &
-                 nconstituents_ID, &
+     parallel_ID, &
-                 ipcoords_ID, &
+     average_ID
-                 avgdefgrad_ID, &
-                 avgfirstpiola_ID
  end enum
- enum, bind(c) 
-   enumerator :: parallel_ID, &
-                 average_ID
- end enum
- integer(kind(undefined_ID)), dimension(:,:), allocatable,         private :: &
-  homogenization_isostrain_outputID                                                                 !< ID of each post result output
- integer(kind(average_ID)),   dimension(:),   allocatable,         private :: &
-  homogenization_isostrain_mapping                                                                  !< mapping type
 
+ type, private :: tParameters                                                                       !< container type for internal constitutive parameters
+   integer(pInt) :: &
+     Nconstituents
+   integer(kind(average_ID)) :: &
+     mapping
+ end type
+
+ type(tParameters), dimension(:), allocatable, private :: param                                     !< containers of constitutive parameters (len Ninstance)
 
  public :: &
    homogenization_isostrain_init, &
    homogenization_isostrain_partitionDeformation, &
-   homogenization_isostrain_averageStressAndItsTangent, &
+   homogenization_isostrain_averageStressAndItsTangent
-   homogenization_isostrain_postResults
 
 contains
 
 !--------------------------------------------------------------------------------------------------
 !> @brief allocates all neccessary fields, reads information from material configuration file
 !--------------------------------------------------------------------------------------------------
-subroutine homogenization_isostrain_init(fileUnit)
+subroutine homogenization_isostrain_init()
 #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
  use, intrinsic :: iso_fortran_env, only: &
    compiler_version, &
    compiler_options
 #endif
- use prec, only: &
-   pReal
  use debug, only: &
    debug_HOMOGENIZATION, &
    debug_level, &
    debug_levelBasic
- use IO
+ use IO, only: &
- use material
+   IO_timeStamp, &
- use config
+   IO_error
+ use material, only: &
+   homogenization_type, &
+   material_homog, &
+   homogState, &
+   HOMOGENIZATION_ISOSTRAIN_ID, &
+   HOMOGENIZATION_ISOSTRAIN_LABEL, &
+   homogenization_typeInstance
+ use config, only: &
+   config_homogenization
  
  implicit none
- integer(pInt),                                      intent(in) :: fileUnit
- integer(pInt), allocatable, dimension(:) :: chunkPos
  integer(pInt) :: &
-   section = 0_pInt, i, mySize, o
+   Ninstance, &
- integer :: &
+   h, &
-   maxNinstance, &
+   NofMyHomog
-   homog, &
-   instance
- integer :: &
-   NofMyHomog                                                                                       ! no pInt (stores a system dependen value from 'count'
  character(len=65536) :: &
-   tag  = '', &
+   tag  = ''
-   line = ''
 
  write(6,'(/,a)')   ' <<<+-  homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init  -+>>>'
  write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
 #include "compilation_info.f90"
 
- maxNinstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)
+ Ninstance = int(count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID),pInt)
- if (maxNinstance == 0) return
- 
  if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) &
-   write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
+   write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
- allocate(homogenization_isostrain_sizePostResults(maxNinstance),          source=0_pInt)
+
- allocate(homogenization_isostrain_sizePostResult(maxval(homogenization_Noutput),maxNinstance), &
+ allocate(param(Ninstance))                                                                         ! one container of parameters per instance
-                                                                           source=0_pInt)
+
- allocate(homogenization_isostrain_Noutput(maxNinstance),                  source=0_pInt)
+ do h = 1_pInt, size(homogenization_type)
- allocate(homogenization_isostrain_Ngrains(maxNinstance),                  source=0_pInt)
+   if (homogenization_type(h) /= HOMOGENIZATION_ISOSTRAIN_ID) cycle
- allocate(homogenization_isostrain_mapping(maxNinstance),                  source=average_ID)
+   
- allocate(homogenization_isostrain_output(maxval(homogenization_Noutput),maxNinstance))
+   associate(prm => param(homogenization_typeInstance(h)),&
-          homogenization_isostrain_output = ''
+             config => config_homogenization(h))
- allocate(homogenization_isostrain_outputID(maxval(homogenization_Noutput),maxNinstance), &
+  
-                                                                           source=undefined_ID)
+   prm%Nconstituents = config_homogenization(h)%getInt('nconstituents')
+   tag = 'sum'
+   select case(trim(config%getString('mapping',defaultVal = tag)))
+     case ('sum')
+       prm%mapping = parallel_ID
+     case ('avg')
+       prm%mapping = average_ID
+     case default
+       call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')')
+   end select
+
+   NofMyHomog = count(material_homog == h)
+   homogState(h)%sizeState       = 0_pInt
+   homogState(h)%sizePostResults = 0_pInt
+   allocate(homogState(h)%state0   (0_pInt,NofMyHomog))
+   allocate(homogState(h)%subState0(0_pInt,NofMyHomog))
+   allocate(homogState(h)%state    (0_pInt,NofMyHomog))
+   
+   end associate
 
- rewind(fileUnit)
- do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
-   line = IO_read(fileUnit)
  enddo
 
- parsingFile: do while (trim(line) /= IO_EOF)                                                       ! read through sections of homogenization part
-   line = IO_read(fileUnit)
-   if (IO_isBlank(line)) cycle                                                                      ! skip empty lines
-   if (IO_getTag(line,'<','>') /= '') then                                                          ! stop at next part
-     line = IO_read(fileUnit, .true.)                                                               ! reset IO_read
-     exit                                                                                           
-   endif
-   if (IO_getTag(line,'[',']') /= '') then                                                          ! next section
-     section = section + 1_pInt
-     cycle
-   endif
-   if (section > 0_pInt ) then                                                                      ! do not short-circuit here (.and. with next if-statement). It's not safe in Fortran
-     if (homogenization_type(section) == HOMOGENIZATION_ISOSTRAIN_ID) then                          ! one of my sections
-       i = homogenization_typeInstance(section)                                                     ! which instance of my type is present homogenization
-       chunkPos = IO_stringPos(line)
-       tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                           ! extract key
-       select case(tag)
-         case ('(output)')
-           select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
-             case('nconstituents','ngrains')
-               homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt
-               homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = nconstituents_ID
-               homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = &
-                 IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-             case('ipcoords')
-               homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt
-               homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = ipcoords_ID
-               homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = &
-                 IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-             case('avgdefgrad','avgf')
-               homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt
-               homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgdefgrad_ID
-               homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = &
-                 IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-             case('avgp','avgfirstpiola','avg1stpiola')
-               homogenization_isostrain_Noutput(i) = homogenization_isostrain_Noutput(i) + 1_pInt
-               homogenization_isostrain_outputID(homogenization_isostrain_Noutput(i),i) = avgfirstpiola_ID
-               homogenization_isostrain_output(homogenization_isostrain_Noutput(i),i) = &
-                 IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-
-           end select
-         case ('nconstituents','ngrains')
-           homogenization_isostrain_Ngrains(i) = IO_intValue(line,chunkPos,2_pInt)
-         case ('mapping')
-           select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
-             case ('parallel','sum')
-               homogenization_isostrain_mapping(i) = parallel_ID
-             case ('average','mean','avg')
-               homogenization_isostrain_mapping(i) = average_ID
-             case default
-               call IO_error(211_pInt,ext_msg=trim(tag)//' ('//HOMOGENIZATION_isostrain_label//')')
-           end select
-
-       end select
-     endif
-   endif
- enddo parsingFile
-
- initializeInstances: do homog = 1_pInt, material_Nhomogenization
-   myHomog: if (homogenization_type(homog) == HOMOGENIZATION_ISOSTRAIN_ID) then
-     NofMyHomog = count(material_homog == homog)
-     instance = homogenization_typeInstance(homog)
-
-! *  Determine size of postResults array
-     outputsLoop: do o = 1_pInt, homogenization_isostrain_Noutput(instance)
-       select case(homogenization_isostrain_outputID(o,instance))
-        case(nconstituents_ID)
-          mySize = 1_pInt
-        case(ipcoords_ID)
-          mySize = 3_pInt
-        case(avgdefgrad_ID, avgfirstpiola_ID)
-          mySize = 9_pInt
-        case default
-          mySize = 0_pInt
-       end select
-
-       outputFound: if (mySize > 0_pInt) then
-        homogenization_isostrain_sizePostResult(o,instance) = mySize
-        homogenization_isostrain_sizePostResults(instance) = &
-          homogenization_isostrain_sizePostResults(instance) + mySize
-       endif outputFound
-     enddo outputsLoop
-
-! allocate state arrays
-     homogState(homog)%sizeState = 0_pInt
-     homogState(homog)%sizePostResults = homogenization_isostrain_sizePostResults(instance)
-     allocate(homogState(homog)%state0   (0_pInt,NofMyHomog), source=0.0_pReal)
-     allocate(homogState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
-     allocate(homogState(homog)%state    (0_pInt,NofMyHomog), source=0.0_pReal)
-
-   endif myHomog
- enddo initializeInstances
-
 end subroutine homogenization_isostrain_init
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief partitions the deformation gradient onto the constituents
 !--------------------------------------------------------------------------------------------------
-subroutine homogenization_isostrain_partitionDeformation(F,avgF,el)
+subroutine homogenization_isostrain_partitionDeformation(F,avgF)
  use prec, only: &
    pReal
- use mesh, only: &
-   mesh_element
- use material, only: &
-   homogenization_maxNgrains, &
-   homogenization_Ngrains
  
  implicit none
- real(pReal),   dimension (3,3,homogenization_maxNgrains), intent(out) :: F                         !< partioned def grad per grain
+ real(pReal),   dimension (:,:,:), intent(out) :: F                                                 !< partitioned deformation gradient
- real(pReal),   dimension (3,3),                           intent(in)  :: avgF                      !< my average def grad
+ 
- integer(pInt),                                            intent(in)  :: &
+ real(pReal),   dimension (3,3),   intent(in)  :: avgF                                              !< average deformation gradient at material point
-   el                                                                                               !< element number
+
- F=0.0_pReal
+ F = spread(avgF,3,size(F,3))
- F(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)))= &
-   spread(avgF,3,homogenization_Ngrains(mesh_element(3,el)))
 
 end subroutine homogenization_isostrain_partitionDeformation
 
@@ -227,90 +127,31 @@ end subroutine homogenization_isostrain_partitionDeformation
 !--------------------------------------------------------------------------------------------------
 !> @brief derive average stress and stiffness from constituent quantities 
 !--------------------------------------------------------------------------------------------------
-subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,el)
+subroutine homogenization_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
  use prec, only: &
    pReal
- use mesh, only: &
-   mesh_element
- use material, only: &
-   homogenization_maxNgrains, &
-   homogenization_Ngrains, &
-   homogenization_typeInstance
  
  implicit none
- real(pReal),   dimension (3,3),                               intent(out) :: avgP                  !< average stress at material point
+ real(pReal),   dimension (3,3),       intent(out) :: avgP                                          !< average stress at material point
- real(pReal),   dimension (3,3,3,3),                           intent(out) :: dAvgPdAvgF            !< average stiffness at material point
+ real(pReal),   dimension (3,3,3,3),   intent(out) :: dAvgPdAvgF                                    !< average stiffness at material point
- real(pReal),   dimension (3,3,homogenization_maxNgrains),     intent(in)  :: P                     !< array of current grain stresses
- real(pReal),   dimension (3,3,3,3,homogenization_maxNgrains), intent(in)  :: dPdF                  !< array of current grain stiffnesses
- integer(pInt),                                                intent(in)  :: el                    !< element number
- integer(pInt) :: &
-   homID, & 
-   Ngrains
 
- homID = homogenization_typeInstance(mesh_element(3,el))
+ real(pReal),   dimension (:,:,:),     intent(in)  :: P                                             !< partitioned stresses
- Ngrains = homogenization_Ngrains(mesh_element(3,el))
+ real(pReal),   dimension (:,:,:,:,:), intent(in)  :: dPdF                                          !< partitioned stiffnesses
+ integer(pInt),                        intent(in)  :: instance 
 
- select case (homogenization_isostrain_mapping(homID))
+ associate(prm => param(instance))
+ 
+ select case (prm%mapping)
    case (parallel_ID)
      avgP       = sum(P,3)
      dAvgPdAvgF = sum(dPdF,5)
    case (average_ID)
-     avgP       = sum(P,3)   /real(Ngrains,pReal)
+     avgP       = sum(P,3)   /real(prm%Nconstituents,pReal)
-     dAvgPdAvgF = sum(dPdF,5)/real(Ngrains,pReal)
+     dAvgPdAvgF = sum(dPdF,5)/real(prm%Nconstituents,pReal)
  end select
  
+ end associate
+
 end subroutine homogenization_isostrain_averageStressAndItsTangent
 
-
-!--------------------------------------------------------------------------------------------------
-!> @brief return array of homogenization results for post file inclusion 
-!--------------------------------------------------------------------------------------------------
-pure function homogenization_isostrain_postResults(ip,el,avgP,avgF)
- use prec, only: &
-   pReal
- use mesh, only: &
-   mesh_element, &
-   mesh_ipCoordinates
- use material, only: &
-   homogenization_typeInstance, &
-   homogenization_Noutput
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), dimension(3,3), intent(in) :: &
-   avgP, &                                                                                          !< average stress at material point
-   avgF                                                                                             !< average deformation gradient at material point
- real(pReal),  dimension(homogenization_isostrain_sizePostResults &
-                         (homogenization_typeInstance(mesh_element(3,el)))) :: &
-   homogenization_isostrain_postResults
- 
- integer(pInt) :: &
-   homID, &
-   o, c
-   
- c = 0_pInt
- homID = homogenization_typeInstance(mesh_element(3,el))
- homogenization_isostrain_postResults = 0.0_pReal
- 
- do o = 1_pInt,homogenization_Noutput(mesh_element(3,el))
-   select case(homogenization_isostrain_outputID(o,homID))
-     case (nconstituents_ID)
-       homogenization_isostrain_postResults(c+1_pInt) = real(homogenization_isostrain_Ngrains(homID),pReal)
-       c = c + 1_pInt
-     case (avgdefgrad_ID)
-       homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(transpose(avgF),[9])
-       c = c + 9_pInt
-     case (avgfirstpiola_ID)
-       homogenization_isostrain_postResults(c+1_pInt:c+9_pInt) = reshape(transpose(avgP),[9])
-       c = c + 9_pInt
-     case (ipcoords_ID)
-       homogenization_isostrain_postResults(c+1_pInt:c+3_pInt) = mesh_ipCoordinates(1:3,ip,el)                       ! current ip coordinates
-       c = c + 3_pInt
-    end select
- enddo
-
-end function homogenization_isostrain_postResults
-
 end module homogenization_isostrain

src/homogenization_none.f90

@@ -2,7 +2,7 @@
 !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
 !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
 !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief dummy homogenization homogenization scheme
+!> @brief dummy homogenization homogenization scheme for 1 constituent per material point
 !--------------------------------------------------------------------------------------------------
 module homogenization_none
 
@@ -24,35 +24,46 @@ subroutine homogenization_none_init()
    compiler_options
 #endif
  use prec, only: &
-   pReal, &
    pInt
+ use debug, only: &
+   debug_HOMOGENIZATION, &
+   debug_level, &
+   debug_levelBasic
  use IO, only: &
    IO_timeStamp
- use material
+
- use config
+ use material, only: &
+   homogenization_type, &
+   material_homog, &
+   homogState, &
+   HOMOGENIZATION_NONE_LABEL, &
+   HOMOGENIZATION_NONE_ID
 
  implicit none
  integer(pInt) :: &
-   homog, &
+   Ninstance, &
+   h, &
    NofMyHomog
 
  write(6,'(/,a)')   ' <<<+-  homogenization_'//HOMOGENIZATION_NONE_label//' init  -+>>>'
  write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
 #include "compilation_info.f90"
 
- initializeInstances: do homog = 1_pInt, material_Nhomogenization
+ Ninstance = int(count(homogenization_type == HOMOGENIZATION_NONE_ID),pInt)
+ if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0_pInt) &
+   write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
 
-   myhomog: if (homogenization_type(homog) == HOMOGENIZATION_none_ID) then
+ do h = 1_pInt, size(homogenization_type)
-     NofMyHomog = count(material_homog == homog)
+   if (homogenization_type(h) /= HOMOGENIZATION_NONE_ID) cycle
-     homogState(homog)%sizeState = 0_pInt
-     homogState(homog)%sizePostResults = 0_pInt
-     allocate(homogState(homog)%state0   (0_pInt,NofMyHomog), source=0.0_pReal)
-     allocate(homogState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
-     allocate(homogState(homog)%state    (0_pInt,NofMyHomog), source=0.0_pReal)
    
-   endif myhomog
+   NofMyHomog = count(material_homog == h)
- enddo initializeInstances
+   homogState(h)%sizeState = 0_pInt
+   homogState(h)%sizePostResults = 0_pInt
+   allocate(homogState(h)%state0   (0_pInt,NofMyHomog))
+   allocate(homogState(h)%subState0(0_pInt,NofMyHomog))
+   allocate(homogState(h)%state    (0_pInt,NofMyHomog))
 
+ enddo
 
 end subroutine homogenization_none_init
 

src/hydrogenflux_cahnhilliard.f90

@@ -1,508 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for conservative transport of solute hydrogen
-!> @details to be done
-!--------------------------------------------------------------------------------------------------
-module hydrogenflux_cahnhilliard
- use prec, only: &
-   pReal, &
-   pInt
-
- implicit none
- private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   hydrogenflux_cahnhilliard_sizePostResults                                                           !< cumulative size of post results
-
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
-   hydrogenflux_cahnhilliard_sizePostResult                                                            !< size of each post result output
-
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
-   hydrogenflux_cahnhilliard_output                                                                    !< name of each post result output
-   
- integer(pInt),                       dimension(:),           allocatable, target, public :: &
-   hydrogenflux_cahnhilliard_Noutput                                                                   !< number of outputs per instance of this damage 
-
- real(pReal),                                                 parameter,           private :: &
-   kB = 1.3806488e-23_pReal                                                                          !< Boltzmann constant in J/Kelvin
-
- enum, bind(c) 
-   enumerator :: undefined_ID, &
-                 hydrogenConc_ID
- end enum
- integer(kind(undefined_ID)),         dimension(:,:),         allocatable,          private :: & 
-   hydrogenflux_cahnhilliard_outputID                                                                  !< ID of each post result output
-
-
- public :: &
-   hydrogenflux_cahnhilliard_init, &
-   hydrogenflux_cahnhilliard_getMobility33, &
-   hydrogenflux_cahnhilliard_getDiffusion33, &
-   hydrogenflux_cahnhilliard_getFormationEnergy, &
-   hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent, &
-   hydrogenflux_cahnhilliard_getChemPotAndItsTangent, &
-   hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate, &
-   hydrogenflux_cahnhilliard_postResults
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine hydrogenflux_cahnhilliard_init(fileUnit)
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use IO, only: &
-   IO_read, &
-   IO_lc, &
-   IO_getTag, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_warning, &
-   IO_error, &
-   IO_timeStamp, &
-   IO_EOF
- use material, only: &
-   hydrogenflux_type, &
-   hydrogenflux_typeInstance, &
-   homogenization_Noutput, &
-   HYDROGENFLUX_cahnhilliard_label, &
-   HYDROGENFLUX_cahnhilliard_ID, &
-   material_homog, &  
-   mappingHomogenization, &
-   hydrogenfluxState, &
-   hydrogenfluxMapping, &
-   hydrogenConc, &
-   hydrogenConcRate, &
-   hydrogenflux_initialCh
- use config, only: &
-   material_partHomogenization, &
-   material_partPhase
-
- implicit none
- integer(pInt), intent(in) :: fileUnit
-
- integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
- integer(pInt) :: sizeState
- integer(pInt) :: NofMyHomog   
- character(len=65536) :: &
-   tag  = '', &
-   line = ''
-
- write(6,'(/,a)')   ' <<<+-  hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
- 
- maxNinstance = int(count(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID),pInt)
- if (maxNinstance == 0_pInt) return
- 
- allocate(hydrogenflux_cahnhilliard_sizePostResults(maxNinstance),                               source=0_pInt)
- allocate(hydrogenflux_cahnhilliard_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
- allocate(hydrogenflux_cahnhilliard_output         (maxval(homogenization_Noutput),maxNinstance))
-          hydrogenflux_cahnhilliard_output = ''
- allocate(hydrogenflux_cahnhilliard_outputID       (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
- allocate(hydrogenflux_cahnhilliard_Noutput        (maxNinstance),                               source=0_pInt) 
-
- rewind(fileUnit)
- section = 0_pInt
- do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
-   line = IO_read(fileUnit)
- enddo
- 
- parsingHomog: do while (trim(line) /= IO_EOF)                                                      ! read through sections of homog 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 homog section
-     section = section + 1_pInt                                                                     ! advance homog section counter
-     cycle                                                                                          ! skip to next line
-   endif
-
-   if (section > 0_pInt ) then; if (hydrogenflux_type(section) == HYDROGENFLUX_cahnhilliard_ID) then  ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
-
-     instance = hydrogenflux_typeInstance(section)                                                   ! which instance of my hydrogenflux is present homog
-     chunkPos = IO_stringPos(line)
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
-     select case(tag)
-       case ('(output)')
-         select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
-           case ('hydrogenconc')
-             hydrogenflux_cahnhilliard_Noutput(instance) = hydrogenflux_cahnhilliard_Noutput(instance) + 1_pInt
-             hydrogenflux_cahnhilliard_outputID(hydrogenflux_cahnhilliard_Noutput(instance),instance) = hydrogenConc_ID
-             hydrogenflux_cahnhilliard_output(hydrogenflux_cahnhilliard_Noutput(instance),instance) = &
-                                                       IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-          end select
-
-     end select
-   endif; endif
- enddo parsingHomog
- 
- rewind(fileUnit)
- section = 0_pInt
- do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase)         ! wind forward to <homogenization>
-   line = IO_read(fileUnit)
- enddo
- 
- initializeInstances: do section = 1_pInt, size(hydrogenflux_type)
-   if (hydrogenflux_type(section) == HYDROGENFLUX_cahnhilliard_ID) then
-     NofMyHomog=count(material_homog==section)
-     instance = hydrogenflux_typeInstance(section)
-
-!--------------------------------------------------------------------------------------------------
-!  Determine size of postResults array
-     outputsLoop: do o = 1_pInt,hydrogenflux_cahnhilliard_Noutput(instance)
-       select case(hydrogenflux_cahnhilliard_outputID(o,instance))
-         case(hydrogenConc_ID)
-           mySize = 1_pInt
-       end select
- 
-       if (mySize > 0_pInt) then  ! any meaningful output found
-          hydrogenflux_cahnhilliard_sizePostResult(o,instance) = mySize
-          hydrogenflux_cahnhilliard_sizePostResults(instance)  = hydrogenflux_cahnhilliard_sizePostResults(instance) + mySize
-       endif
-     enddo outputsLoop
-
-! allocate state arrays
-     sizeState = 0_pInt
-     hydrogenfluxState(section)%sizeState = sizeState
-     hydrogenfluxState(section)%sizePostResults = hydrogenflux_cahnhilliard_sizePostResults(instance)
-     allocate(hydrogenfluxState(section)%state0   (sizeState,NofMyHomog))
-     allocate(hydrogenfluxState(section)%subState0(sizeState,NofMyHomog))
-     allocate(hydrogenfluxState(section)%state    (sizeState,NofMyHomog))
-
-     nullify(hydrogenfluxMapping(section)%p)
-     hydrogenfluxMapping(section)%p => mappingHomogenization(1,:,:)
-     deallocate(hydrogenConc    (section)%p)
-     deallocate(hydrogenConcRate(section)%p)
-     allocate  (hydrogenConc    (section)%p(NofMyHomog), source=hydrogenflux_initialCh(section))
-     allocate  (hydrogenConcRate(section)%p(NofMyHomog), source=0.0_pReal)
-     
-   endif
- 
- enddo initializeInstances
- 
-end subroutine hydrogenflux_cahnhilliard_init
-
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized solute mobility tensor in reference configuration
-!--------------------------------------------------------------------------------------------------
-function hydrogenflux_cahnhilliard_getMobility33(ip,el)
- use lattice, only: &
-   lattice_hydrogenfluxMobility33
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase
- use mesh, only: &
-   mesh_element
- use crystallite, only: &
-   crystallite_push33ToRef
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), dimension(3,3) :: &
-   hydrogenflux_cahnhilliard_getMobility33
- integer(pInt) :: &
-   grain
-  
- hydrogenflux_cahnhilliard_getMobility33 = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mesh_element(3,el))
-   hydrogenflux_cahnhilliard_getMobility33 = hydrogenflux_cahnhilliard_getMobility33 + &
-    crystallite_push33ToRef(grain,ip,el,lattice_hydrogenfluxMobility33(:,:,material_phase(grain,ip,el)))
- enddo
-
- hydrogenflux_cahnhilliard_getMobility33 = &
-   hydrogenflux_cahnhilliard_getMobility33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
- 
-end function hydrogenflux_cahnhilliard_getMobility33
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized solute nonlocal diffusion tensor in reference configuration
-!--------------------------------------------------------------------------------------------------
-function hydrogenflux_cahnhilliard_getDiffusion33(ip,el)
- use lattice, only: &
-   lattice_hydrogenfluxDiffusion33
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase
- use mesh, only: &
-   mesh_element
- use crystallite, only: &
-   crystallite_push33ToRef
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), dimension(3,3) :: &
-   hydrogenflux_cahnhilliard_getDiffusion33
- integer(pInt) :: &
-   grain
-  
- hydrogenflux_cahnhilliard_getDiffusion33 = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mesh_element(3,el))
-   hydrogenflux_cahnhilliard_getDiffusion33 = hydrogenflux_cahnhilliard_getDiffusion33 + &
-    crystallite_push33ToRef(grain,ip,el,lattice_hydrogenfluxDiffusion33(:,:,material_phase(grain,ip,el)))
- enddo
-
- hydrogenflux_cahnhilliard_getDiffusion33 = &
-   hydrogenflux_cahnhilliard_getDiffusion33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
- 
-end function hydrogenflux_cahnhilliard_getDiffusion33
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized solution energy
-!--------------------------------------------------------------------------------------------------
-function hydrogenflux_cahnhilliard_getFormationEnergy(ip,el)
- use lattice, only: &
-   lattice_hydrogenFormationEnergy, &
-   lattice_hydrogenVol, &
-   lattice_hydrogenSurfaceEnergy
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase
- use mesh, only: &
-   mesh_element
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal) :: &
-   hydrogenflux_cahnhilliard_getFormationEnergy
- integer(pInt) :: &
-   grain
-  
- hydrogenflux_cahnhilliard_getFormationEnergy = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mesh_element(3,el))
-   hydrogenflux_cahnhilliard_getFormationEnergy = hydrogenflux_cahnhilliard_getFormationEnergy + &
-    lattice_hydrogenFormationEnergy(material_phase(grain,ip,el))/ &
-    lattice_hydrogenVol(material_phase(grain,ip,el))/ &
-    lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el))
- enddo
-
- hydrogenflux_cahnhilliard_getFormationEnergy = &
-   hydrogenflux_cahnhilliard_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
- 
-end function hydrogenflux_cahnhilliard_getFormationEnergy
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized hydrogen entropy coefficient
-!--------------------------------------------------------------------------------------------------
-function hydrogenflux_cahnhilliard_getEntropicCoeff(ip,el)
- use lattice, only: &
-   lattice_hydrogenVol, &
-   lattice_hydrogenSurfaceEnergy
- use material, only: &
-   homogenization_Ngrains, &
-   material_homog, &
-   material_phase, &
-   temperature, &
-   thermalMapping
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal) :: &
-   hydrogenflux_cahnhilliard_getEntropicCoeff
- integer(pInt) :: &
-   grain
-  
- hydrogenflux_cahnhilliard_getEntropicCoeff = 0.0_pReal
- do grain = 1, homogenization_Ngrains(material_homog(ip,el))
-   hydrogenflux_cahnhilliard_getEntropicCoeff = hydrogenflux_cahnhilliard_getEntropicCoeff + &
-    kB/ &
-    lattice_hydrogenVol(material_phase(grain,ip,el))/ &
-    lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el))
- enddo
-
- hydrogenflux_cahnhilliard_getEntropicCoeff = hydrogenflux_cahnhilliard_getEntropicCoeff* &
-   temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))/ &
-   real(homogenization_Ngrains(material_homog(ip,el)),pReal)
- 
-end function hydrogenflux_cahnhilliard_getEntropicCoeff
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized kinematic contribution to chemical potential
-!--------------------------------------------------------------------------------------------------
-subroutine hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCh, Ch, ip, el)
- use lattice, only: &
-   lattice_hydrogenSurfaceEnergy
- use material, only: &
-   homogenization_Ngrains, &
-   material_homog, &
-   phase_kinematics, &
-   phase_Nkinematics, &
-   material_phase, &
-   KINEMATICS_hydrogen_strain_ID
- use crystallite, only: &
-   crystallite_Tstar_v, &
-   crystallite_Fi0, &
-   crystallite_Fi
- use kinematics_hydrogen_strain, only: &
-   kinematics_hydrogen_strain_ChemPotAndItsTangent
-
- implicit none
- integer(pInt), intent(in)  :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in)  :: &
-   Ch
- real(pReal),   intent(out) :: &
-   KPot, dKPot_dCh
- real(pReal) :: &
-   my_KPot, my_dKPot_dCh
- integer(pInt) :: &
-   grain, kinematics
-  
- KPot = 0.0_pReal
- dKPot_dCh = 0.0_pReal
- do grain = 1_pInt,homogenization_Ngrains(material_homog(ip,el)) 
-   do kinematics = 1_pInt, phase_Nkinematics(material_phase(grain,ip,el))
-     select case (phase_kinematics(kinematics,material_phase(grain,ip,el)))
-       case (KINEMATICS_hydrogen_strain_ID)
-         call kinematics_hydrogen_strain_ChemPotAndItsTangent(my_KPot, my_dKPot_dCh, &
-                                                             crystallite_Tstar_v(1:6,grain,ip,el), &
-                                                             crystallite_Fi0(1:3,1:3,grain,ip,el), &
-                                                             crystallite_Fi (1:3,1:3,grain,ip,el), &
-                                                             grain,ip, el)
-
-       case default
-         my_KPot = 0.0_pReal
-         my_dKPot_dCh = 0.0_pReal
-     
-     end select
-     KPot = KPot + my_KPot/lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el))
-     dKPot_dCh = dKPot_dCh + my_dKPot_dCh/lattice_hydrogenSurfaceEnergy(material_phase(grain,ip,el))
-   enddo
- enddo 
- 
- KPot = KPot/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
- dKPot_dCh = dKPot_dCh/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
-
-end subroutine hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized chemical potential
-!--------------------------------------------------------------------------------------------------
-subroutine hydrogenflux_cahnhilliard_getChemPotAndItsTangent(ChemPot,dChemPot_dCh,Ch,ip,el)
- use numerics, only: &
-   hydrogenBoundPenalty, &
-   hydrogenPolyOrder
-
- implicit none
- integer(pInt), intent(in)  :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in)  :: &
-   Ch
- real(pReal),   intent(out) :: &
-   ChemPot, &
-   dChemPot_dCh
- real(pReal) :: &
-   kBT, KPot, dKPot_dCh  
- integer(pInt) :: &
-   o  
-  
- ChemPot = hydrogenflux_cahnhilliard_getFormationEnergy(ip,el)
- dChemPot_dCh = 0.0_pReal
- kBT = hydrogenflux_cahnhilliard_getEntropicCoeff(ip,el)
- do o = 1_pInt, hydrogenPolyOrder
-   ChemPot = ChemPot + kBT*((2.0_pReal*Ch - 1.0_pReal)**real(2_pInt*o-1_pInt,pReal))/ &
-                       real(2_pInt*o-1_pInt,pReal)
-   dChemPot_dCh = dChemPot_dCh + 2.0_pReal*kBT*(2.0_pReal*Ch - 1.0_pReal)**real(2_pInt*o-2_pInt,pReal) 
- enddo
- 
- call hydrogenflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCh, Ch, ip, el)
- ChemPot = ChemPot + KPot 
- dChemPot_dCh = dChemPot_dCh + dKPot_dCh
-
- if (Ch < 0.0_pReal) then
-   ChemPot = ChemPot - 3.0_pReal*hydrogenBoundPenalty*Ch*Ch
-   dChemPot_dCh = dChemPot_dCh - 6.0_pReal*hydrogenBoundPenalty*Ch
- elseif (Ch > 1.0_pReal) then
-   ChemPot = ChemPot + 3.0_pReal*hydrogenBoundPenalty*(1.0_pReal - Ch)*(1.0_pReal - Ch)
-   dChemPot_dCh = dChemPot_dCh - 6.0_pReal*hydrogenBoundPenalty*(1.0_pReal - Ch)
- endif       
- 
-end subroutine hydrogenflux_cahnhilliard_getChemPotAndItsTangent
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief updates hydrogen concentration with solution from Cahn-Hilliard PDE for solute transport
-!--------------------------------------------------------------------------------------------------
-subroutine hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate(Ch,Chdot,ip,el)
- use material, only: &
-   mappingHomogenization, &
-   hydrogenConc, &
-   hydrogenConcRate, &
-   hydrogenfluxMapping
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in) :: &
-   Ch, &
-   Chdot
- integer(pInt) :: &
-   homog, &
-   offset  
- 
- homog  = mappingHomogenization(2,ip,el)
- offset = hydrogenfluxMapping(homog)%p(ip,el)
- hydrogenConc    (homog)%p(offset) = Ch
- hydrogenConcRate(homog)%p(offset) = Chdot
-
-end subroutine hydrogenflux_cahnhilliard_putHydrogenConcAndItsRate
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief return array of hydrogen transport results
-!--------------------------------------------------------------------------------------------------
-function hydrogenflux_cahnhilliard_postResults(ip,el)
- use material, only: &
-   mappingHomogenization, &
-   hydrogenflux_typeInstance, &
-   hydrogenConc, &
-   hydrogenfluxMapping
-
- implicit none
- integer(pInt),              intent(in) :: &
-   ip, &                                                                                            !< integration point
-   el                                                                                               !< element
- real(pReal), dimension(hydrogenflux_cahnhilliard_sizePostResults(hydrogenflux_typeInstance(mappingHomogenization(2,ip,el)))) :: &
-   hydrogenflux_cahnhilliard_postResults
-
- integer(pInt) :: &
-   instance, homog, offset, o, c
-   
- homog     = mappingHomogenization(2,ip,el)
- offset    = hydrogenfluxMapping(homog)%p(ip,el)
- instance  = hydrogenflux_typeInstance(homog)
-
- c = 0_pInt
- hydrogenflux_cahnhilliard_postResults = 0.0_pReal
-
- do o = 1_pInt,hydrogenflux_cahnhilliard_Noutput(instance)
-    select case(hydrogenflux_cahnhilliard_outputID(o,instance))
- 
-      case (hydrogenConc_ID)
-        hydrogenflux_cahnhilliard_postResults(c+1_pInt) = hydrogenConc(homog)%p(offset)
-        c = c + 1
-    end select
- enddo
-end function hydrogenflux_cahnhilliard_postResults
-
-end module hydrogenflux_cahnhilliard

src/hydrogenflux_isoconc.f90

@@ -1,62 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for constant hydrogen concentration
-!--------------------------------------------------------------------------------------------------
-module hydrogenflux_isoconc
-
- implicit none
- private
- 
- public :: &
-   hydrogenflux_isoconc_init
-
-contains
-
-!--------------------------------------------------------------------------------------------------
-!> @brief allocates all neccessary fields, reads information from material configuration file
-!--------------------------------------------------------------------------------------------------
-subroutine hydrogenflux_isoconc_init()
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use prec, only: &
-   pReal, &
-   pInt 
- use IO, only: &
-   IO_timeStamp
- use material
- use config
- 
- implicit none
- integer(pInt) :: &
-   homog, &
-   NofMyHomog
-
- write(6,'(/,a)')   ' <<<+-  hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
-
- initializeInstances: do homog = 1_pInt, material_Nhomogenization
-   
-   myhomog: if (hydrogenflux_type(homog) == HYDROGENFLUX_isoconc_ID) then
-     NofMyHomog = count(material_homog == homog)
-     hydrogenfluxState(homog)%sizeState = 0_pInt
-     hydrogenfluxState(homog)%sizePostResults = 0_pInt
-     allocate(hydrogenfluxState(homog)%state0   (0_pInt,NofMyHomog), source=0.0_pReal)
-     allocate(hydrogenfluxState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
-     allocate(hydrogenfluxState(homog)%state    (0_pInt,NofMyHomog), source=0.0_pReal)
-     
-     deallocate(hydrogenConc    (homog)%p)
-     deallocate(hydrogenConcRate(homog)%p)
-     allocate  (hydrogenConc    (homog)%p(1), source=hydrogenflux_initialCh(homog))
-     allocate  (hydrogenConcRate(homog)%p(1), source=0.0_pReal)
-
-   endif myhomog
- enddo initializeInstances
-
-
-end subroutine hydrogenflux_isoconc_init
-
-end module hydrogenflux_isoconc

src/kinematics_hydrogen_strain.f90

@@ -1,263 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine incorporating kinematics resulting from interstitial hydrogen
-!> @details to be done
-!--------------------------------------------------------------------------------------------------
-module kinematics_hydrogen_strain
- use prec, only: &
-   pReal, &
-   pInt
-
- implicit none
- private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   kinematics_hydrogen_strain_sizePostResults, &                                                                !< cumulative size of post results
-   kinematics_hydrogen_strain_offset, &                                                                         !< which kinematics is my current damage mechanism?
-   kinematics_hydrogen_strain_instance                                                                          !< instance of damage kinematics mechanism
-
- integer(pInt),                       dimension(:,:),         allocatable, target, public  :: &
-   kinematics_hydrogen_strain_sizePostResult                                                                    !< size of each post result output
-
- character(len=64),                   dimension(:,:),         allocatable, target, public  :: &
-   kinematics_hydrogen_strain_output                                                                            !< name of each post result output
-   
- integer(pInt),                       dimension(:),           allocatable, target, public  :: &
-   kinematics_hydrogen_strain_Noutput                                                                           !< number of outputs per instance of this damage 
-
- real(pReal),                         dimension(:),           allocatable,         private :: &
-   kinematics_hydrogen_strain_coeff
-
- public :: &
-   kinematics_hydrogen_strain_init, &
-   kinematics_hydrogen_strain_initialStrain, &
-   kinematics_hydrogen_strain_LiAndItsTangent, &
-   kinematics_hydrogen_strain_ChemPotAndItsTangent
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine kinematics_hydrogen_strain_init(fileUnit)
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use debug, only: &
-   debug_level,&
-   debug_constitutive,&
-   debug_levelBasic
- use IO, only: &
-   IO_read, &
-   IO_lc, &
-   IO_getTag, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_warning, &
-   IO_error, &
-   IO_timeStamp, &
-   IO_EOF
- use material, only: &
-   phase_kinematics, &
-   phase_Nkinematics, &
-   phase_Noutput, &
-   KINEMATICS_hydrogen_strain_label, &
-   KINEMATICS_hydrogen_strain_ID
- use config, only: &
-   material_Nphase, &
-   MATERIAL_partPhase
-
- implicit none
- integer(pInt), intent(in) :: fileUnit
-
- integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: maxNinstance,phase,instance,kinematics
- character(len=65536) :: &
-   tag  = '', &
-   line = ''
-
- write(6,'(/,a)')   ' <<<+-  kinematics_'//KINEMATICS_hydrogen_strain_LABEL//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
-
- maxNinstance = int(count(phase_kinematics == KINEMATICS_hydrogen_strain_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(kinematics_hydrogen_strain_offset(material_Nphase), source=0_pInt)
- allocate(kinematics_hydrogen_strain_instance(material_Nphase), source=0_pInt)
- do phase = 1, material_Nphase
-   kinematics_hydrogen_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_hydrogen_strain_ID)
-   do kinematics = 1, phase_Nkinematics(phase)
-     if (phase_kinematics(kinematics,phase) == kinematics_hydrogen_strain_ID) &
-       kinematics_hydrogen_strain_offset(phase) = kinematics
-   enddo    
- enddo
-   
- allocate(kinematics_hydrogen_strain_sizePostResults(maxNinstance),                     source=0_pInt)
- allocate(kinematics_hydrogen_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
- allocate(kinematics_hydrogen_strain_output(maxval(phase_Noutput),maxNinstance))
-          kinematics_hydrogen_strain_output = ''
- allocate(kinematics_hydrogen_strain_Noutput(maxNinstance),                             source=0_pInt) 
- allocate(kinematics_hydrogen_strain_coeff(maxNinstance),                               source=0.0_pReal) 
-
- 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 phase section
-     phase = phase + 1_pInt                                                                         ! advance phase section counter
-     cycle                                                                                          ! skip to next line
-   endif
-   if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_hydrogen_strain_ID)) then         ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
-     instance = kinematics_hydrogen_strain_instance(phase)                                                         ! which instance of my damage is present phase
-     chunkPos = IO_stringPos(line)
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
-     select case(tag)
-       case ('hydrogen_strain_coeff')
-         kinematics_hydrogen_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt)
-
-     end select
-   endif; endif
- enddo parsingFile
-
-end subroutine kinematics_hydrogen_strain_init
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  report initial hydrogen strain based on current hydrogen conc deviation from 
-!>         equillibrium (0)
-!--------------------------------------------------------------------------------------------------
-pure function kinematics_hydrogen_strain_initialStrain(ipc, ip, el)
- use math, only: &
-   math_I3
- use material, only: &
-   material_phase, &
-   material_homog, &
-   hydrogenConc, &
-   hydrogenfluxMapping
- use lattice, only: &
-   lattice_equilibriumHydrogenConcentration
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< grain number
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), dimension(3,3) :: &
-   kinematics_hydrogen_strain_initialStrain                                                       !< initial thermal strain (should be small strain, though)
- integer(pInt) :: &
-   phase, &
-   homog, offset, instance
-   
- phase = material_phase(ipc,ip,el)
- instance = kinematics_hydrogen_strain_instance(phase)
- homog = material_homog(ip,el)
- offset = hydrogenfluxMapping(homog)%p(ip,el)
- 
- kinematics_hydrogen_strain_initialStrain = &
-   (hydrogenConc(homog)%p(offset) - lattice_equilibriumHydrogenConcentration(phase)) * &
-   kinematics_hydrogen_strain_coeff(instance)* math_I3
-  
-end function kinematics_hydrogen_strain_initialStrain
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  contains the constitutive equation for calculating the velocity gradient  
-!--------------------------------------------------------------------------------------------------
-subroutine kinematics_hydrogen_strain_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el)
- use material, only: &
-   material_phase, &
-   material_homog, &
-   hydrogenConc, &
-   hydrogenConcRate, &
-   hydrogenfluxMapping
- use math, only: &
-   math_I3
- use lattice, only: &
-   lattice_equilibriumHydrogenConcentration
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< grain number
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(out), dimension(3,3) :: &
-   Li                                                                                               !< thermal velocity gradient
- real(pReal),   intent(out), dimension(3,3,3,3) :: &
-   dLi_dTstar3333                                                                                   !< derivative of Li with respect to Tstar (4th-order tensor)
- integer(pInt) :: &
-   phase, &
-   instance, &
-   homog, offset
- real(pReal) :: &
-   Ch, ChEq, ChDot  
-   
- phase = material_phase(ipc,ip,el)
- instance = kinematics_hydrogen_strain_instance(phase)
- homog = material_homog(ip,el)
- offset = hydrogenfluxMapping(homog)%p(ip,el)
- Ch = hydrogenConc(homog)%p(offset)
- ChDot = hydrogenConcRate(homog)%p(offset)
- ChEq = lattice_equilibriumHydrogenConcentration(phase)
- 
- Li = ChDot*math_I3* &
-      kinematics_hydrogen_strain_coeff(instance)/ &
-      (1.0_pReal + kinematics_hydrogen_strain_coeff(instance)*(Ch - ChEq))
- dLi_dTstar3333 = 0.0_pReal
-  
-end subroutine kinematics_hydrogen_strain_LiAndItsTangent
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  contains the kinematic contribution to hydrogen chemical potential  
-!--------------------------------------------------------------------------------------------------
-subroutine kinematics_hydrogen_strain_ChemPotAndItsTangent(ChemPot, dChemPot_dCh, Tstar_v, Fi0, Fi, ipc, ip, el)
- use material, only: &
-   material_phase
- use math, only: &
-   math_inv33, &
-   math_mul33x33, &
-   math_Mandel6to33, &
-   math_transpose33
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< grain number
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),  intent(in), dimension(6) :: &
-   Tstar_v
- real(pReal),  intent(in), dimension(3,3) :: &
-   Fi0, Fi
- real(pReal),   intent(out) :: &
-   ChemPot, dChemPot_dCh                                                               
- integer(pInt) :: &
-   phase, &
-   instance
-   
- phase = material_phase(ipc,ip,el)
- instance = kinematics_hydrogen_strain_instance(phase)
- 
- ChemPot = -kinematics_hydrogen_strain_coeff(instance)* &
-            sum(math_mul33x33(Fi,math_Mandel6to33(Tstar_v))* &
-                math_mul33x33(math_mul33x33(Fi,math_inv33(Fi0)),Fi))
- dChemPot_dCh = 0.0_pReal
-   
-end subroutine kinematics_hydrogen_strain_ChemPotAndItsTangent
-
-end module kinematics_hydrogen_strain

src/kinematics_vacancy_strain.f90

@@ -1,264 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine incorporating kinematics resulting from vacancy point defects
-!> @details to be done
-!--------------------------------------------------------------------------------------------------
-module kinematics_vacancy_strain
- use prec, only: &
-   pReal, &
-   pInt
-
- implicit none
- private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   kinematics_vacancy_strain_sizePostResults, &                                                                !< cumulative size of post results
-   kinematics_vacancy_strain_offset, &                                                                         !< which kinematics is my current damage mechanism?
-   kinematics_vacancy_strain_instance                                                                          !< instance of damage kinematics mechanism
-
- integer(pInt),                       dimension(:,:),         allocatable, target, public  :: &
-   kinematics_vacancy_strain_sizePostResult                                                                    !< size of each post result output
-
- character(len=64),                   dimension(:,:),         allocatable, target, public  :: &
-   kinematics_vacancy_strain_output                                                                            !< name of each post result output
-   
- integer(pInt),                       dimension(:),           allocatable, target, public  :: &
-   kinematics_vacancy_strain_Noutput                                                                           !< number of outputs per instance of this damage 
-
- real(pReal),                         dimension(:),           allocatable,         private :: &
-   kinematics_vacancy_strain_coeff
-
- public :: &
-   kinematics_vacancy_strain_init, &
-   kinematics_vacancy_strain_initialStrain, &
-   kinematics_vacancy_strain_LiAndItsTangent, &
-   kinematics_vacancy_strain_ChemPotAndItsTangent
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine kinematics_vacancy_strain_init(fileUnit)
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use debug, only: &
-   debug_level,&
-   debug_constitutive,&
-   debug_levelBasic
- use IO, only: &
-   IO_read, &
-   IO_lc, &
-   IO_getTag, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_warning, &
-   IO_error, &
-   IO_timeStamp, &
-   IO_EOF
- use material, only: &
-   phase_kinematics, &
-   phase_Nkinematics, &
-   phase_Noutput, &
-   KINEMATICS_vacancy_strain_label, &
-   KINEMATICS_vacancy_strain_ID
- use config, only: &
-   material_Nphase, &
-   MATERIAL_partPhase
-
- implicit none
- integer(pInt), intent(in) :: fileUnit
-
- integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: maxNinstance,phase,instance,kinematics
- character(len=65536) :: &
-   tag  = '', &
-   line = ''
-
- write(6,'(/,a)')   ' <<<+-  kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
-
- maxNinstance = int(count(phase_kinematics == KINEMATICS_vacancy_strain_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(kinematics_vacancy_strain_offset(material_Nphase), source=0_pInt)
- allocate(kinematics_vacancy_strain_instance(material_Nphase), source=0_pInt)
- do phase = 1, material_Nphase
-   kinematics_vacancy_strain_instance(phase) = count(phase_kinematics(:,1:phase) == kinematics_vacancy_strain_ID)
-   do kinematics = 1, phase_Nkinematics(phase)
-     if (phase_kinematics(kinematics,phase) == kinematics_vacancy_strain_ID) &
-       kinematics_vacancy_strain_offset(phase) = kinematics
-   enddo    
- enddo
-   
- allocate(kinematics_vacancy_strain_sizePostResults(maxNinstance),                     source=0_pInt)
- allocate(kinematics_vacancy_strain_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
- allocate(kinematics_vacancy_strain_output(maxval(phase_Noutput),maxNinstance))
-          kinematics_vacancy_strain_output = ''
- allocate(kinematics_vacancy_strain_Noutput(maxNinstance),                             source=0_pInt) 
- allocate(kinematics_vacancy_strain_coeff(maxNinstance),                               source=0.0_pReal) 
-
- 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 phase section
-     phase = phase + 1_pInt                                                                         ! advance phase section counter
-     cycle                                                                                          ! skip to next line
-   endif
-   if (phase > 0_pInt ) then; if (any(phase_kinematics(:,phase) == KINEMATICS_vacancy_strain_ID)) then         ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
-     instance = kinematics_vacancy_strain_instance(phase)                                                         ! which instance of my damage is present phase
-     chunkPos = IO_stringPos(line)
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
-     select case(tag)
-       case ('vacancy_strain_coeff')
-         kinematics_vacancy_strain_coeff(instance) = IO_floatValue(line,chunkPos,2_pInt)
-
-     end select
-   endif; endif
- enddo parsingFile
-
-end subroutine kinematics_vacancy_strain_init
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  report initial vacancy strain based on current vacancy conc deviation from equillibrium
-!--------------------------------------------------------------------------------------------------
-pure function kinematics_vacancy_strain_initialStrain(ipc, ip, el)
- use math, only: &
-   math_I3
- use material, only: &
-   material_phase, &
-   material_homog, &
-   vacancyConc, &
-   vacancyfluxMapping
- use lattice, only: &
-   lattice_equilibriumVacancyConcentration
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< grain number
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), dimension(3,3) :: &
-   kinematics_vacancy_strain_initialStrain                                                       !< initial thermal strain (should be small strain, though)
- integer(pInt) :: &
-   phase, &
-   homog, offset, instance
-   
- phase = material_phase(ipc,ip,el)
- instance = kinematics_vacancy_strain_instance(phase)
- homog = material_homog(ip,el)
- offset = vacancyfluxMapping(homog)%p(ip,el)
- 
- kinematics_vacancy_strain_initialStrain = &
-   (vacancyConc(homog)%p(offset) - lattice_equilibriumVacancyConcentration(phase)) * &
-   kinematics_vacancy_strain_coeff(instance)* math_I3
-  
-end function kinematics_vacancy_strain_initialStrain
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  contains the constitutive equation for calculating the velocity gradient  
-!--------------------------------------------------------------------------------------------------
-subroutine kinematics_vacancy_strain_LiAndItsTangent(Li, dLi_dTstar3333, ipc, ip, el)
- use material, only: &
-   material_phase, &
-   material_homog, &
-   vacancyConc, &
-   vacancyConcRate, &
-   vacancyfluxMapping
- use math, only: &
-   math_I3
- use lattice, only: &
-   lattice_equilibriumVacancyConcentration
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< grain number
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(out), dimension(3,3) :: &
-   Li                                                                                               !< thermal velocity gradient
- real(pReal),   intent(out), dimension(3,3,3,3) :: &
-   dLi_dTstar3333                                                                                   !< derivative of Li with respect to Tstar (4th-order tensor)
- integer(pInt) :: &
-   phase, &
-   instance, &
-   homog, offset
- real(pReal) :: &
-   Cv, CvEq, CvDot  
-   
- phase = material_phase(ipc,ip,el)
- instance = kinematics_vacancy_strain_instance(phase)
- homog = material_homog(ip,el)
- offset = vacancyfluxMapping(homog)%p(ip,el)
- 
- Cv = vacancyConc(homog)%p(offset)
- CvDot = vacancyConcRate(homog)%p(offset)
- CvEq = lattice_equilibriumvacancyConcentration(phase)
- 
- Li = CvDot*math_I3* &
-      kinematics_vacancy_strain_coeff(instance)/ &
-      (1.0_pReal + kinematics_vacancy_strain_coeff(instance)*(Cv - CvEq))
-      
- dLi_dTstar3333 = 0.0_pReal
-  
-end subroutine kinematics_vacancy_strain_LiAndItsTangent
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  contains the kinematic contribution to vacancy chemical potential  
-!--------------------------------------------------------------------------------------------------
-subroutine kinematics_vacancy_strain_ChemPotAndItsTangent(ChemPot, dChemPot_dCv, Tstar_v, Fi0, Fi, ipc, ip, el)
- use material, only: &
-   material_phase
- use math, only: &
-   math_inv33, &
-   math_mul33x33, &
-   math_Mandel6to33, &
-   math_transpose33
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< grain number
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),  intent(in), dimension(6) :: &
-   Tstar_v
- real(pReal),  intent(in), dimension(3,3) :: &
-   Fi0, Fi
- real(pReal),   intent(out) :: &
-   ChemPot, dChemPot_dCv                                                               
- integer(pInt) :: &
-   phase, &
-   instance
-   
- phase = material_phase(ipc,ip,el)
- instance = kinematics_vacancy_strain_instance(phase)
- 
- ChemPot = -kinematics_vacancy_strain_coeff(instance)* &
-            sum(math_mul33x33(Fi,math_Mandel6to33(Tstar_v))* &
-                math_mul33x33(math_mul33x33(Fi,math_inv33(Fi0)),Fi))
- dChemPot_dCv = 0.0_pReal
-   
-end subroutine kinematics_vacancy_strain_ChemPotAndItsTangent
-
-end module kinematics_vacancy_strain

src/material.f90

@@ -36,29 +36,16 @@ module material
    SOURCE_damage_isoDuctile_label       = 'damage_isoductile', &
    SOURCE_damage_anisoBrittle_label     = 'damage_anisobrittle', &
    SOURCE_damage_anisoDuctile_label     = 'damage_anisoductile', &
-   SOURCE_vacancy_phenoplasticity_label = 'vacancy_phenoplasticity', &
-   SOURCE_vacancy_irradiation_label     = 'vacancy_irradiation', &
-   SOURCE_vacancy_thermalfluc_label     = 'vacancy_thermalfluctuation', &
    KINEMATICS_thermal_expansion_label   = 'thermal_expansion', &
    KINEMATICS_cleavage_opening_label    = 'cleavage_opening', &
    KINEMATICS_slipplane_opening_label   = 'slipplane_opening', &
-   KINEMATICS_vacancy_strain_label      = 'vacancy_strain', &
-   KINEMATICS_hydrogen_strain_label     = 'hydrogen_strain', &
    STIFFNESS_DEGRADATION_damage_label   = 'damage', &
-   STIFFNESS_DEGRADATION_porosity_label = 'porosity', &
    THERMAL_isothermal_label             = 'isothermal', &
    THERMAL_adiabatic_label              = 'adiabatic', &
    THERMAL_conduction_label             = 'conduction', &
    DAMAGE_none_label                    = 'none', &
    DAMAGE_local_label                   = 'local', &
    DAMAGE_nonlocal_label                = 'nonlocal', &
-   VACANCYFLUX_isoconc_label            = 'isoconcentration', &
-   VACANCYFLUX_isochempot_label         = 'isochemicalpotential', &
-   VACANCYFLUX_cahnhilliard_label       = 'cahnhilliard', &
-   POROSITY_none_label                  = 'none', &
-   POROSITY_phasefield_label            = 'phasefield', &
-   HYDROGENFLUX_isoconc_label           = 'isoconcentration', &
-   HYDROGENFLUX_cahnhilliard_label      = 'cahnhilliard', &
    HOMOGENIZATION_none_label            = 'none', &
    HOMOGENIZATION_isostrain_label       = 'isostrain', &
    HOMOGENIZATION_rgc_label             = 'rgc'
@@ -87,25 +74,19 @@ module material
                  SOURCE_damage_isoBrittle_ID, &
                  SOURCE_damage_isoDuctile_ID, &
                  SOURCE_damage_anisoBrittle_ID, &
-                 SOURCE_damage_anisoDuctile_ID, &
+                 SOURCE_damage_anisoDuctile_ID
-                 SOURCE_vacancy_phenoplasticity_ID, &
-                 SOURCE_vacancy_irradiation_ID, &
-                 SOURCE_vacancy_thermalfluc_ID
  end enum
 
  enum, bind(c)
    enumerator :: KINEMATICS_undefined_ID, &
                  KINEMATICS_cleavage_opening_ID, &
                  KINEMATICS_slipplane_opening_ID, &
-                 KINEMATICS_thermal_expansion_ID, &
+                 KINEMATICS_thermal_expansion_ID
-                 KINEMATICS_vacancy_strain_ID, &
-                 KINEMATICS_hydrogen_strain_ID
  end enum
 
  enum, bind(c)
    enumerator :: STIFFNESS_DEGRADATION_undefined_ID, &
-                 STIFFNESS_DEGRADATION_damage_ID, &
+                 STIFFNESS_DEGRADATION_damage_ID
-                 STIFFNESS_DEGRADATION_porosity_ID
  end enum
 
  enum, bind(c)
@@ -120,21 +101,6 @@ module material
                  DAMAGE_nonlocal_ID
  end enum
 
- enum, bind(c)
-   enumerator :: VACANCYFLUX_isoconc_ID, &
-                 VACANCYFLUX_isochempot_ID, &
-                 VACANCYFLUX_cahnhilliard_ID
- end enum
-
- enum, bind(c)
-   enumerator :: POROSITY_none_ID, &
-                 POROSITY_phasefield_ID
- end enum
- enum, bind(c)
-   enumerator :: HYDROGENFLUX_isoconc_ID, &
-                 HYDROGENFLUX_cahnhilliard_ID
- end enum
-
  enum, bind(c)
    enumerator :: HOMOGENIZATION_undefined_ID, &
                  HOMOGENIZATION_none_ID, &
@@ -150,12 +116,6 @@ module material
    thermal_type                                                                                     !< thermal transport model
  integer(kind(DAMAGE_none_ID)),              dimension(:),   allocatable, public, protected :: &
    damage_type                                                                                      !< nonlocal damage model
- integer(kind(VACANCYFLUX_isoconc_ID)),      dimension(:),   allocatable, public, protected :: &
-   vacancyflux_type                                                                                 !< vacancy transport model
- integer(kind(POROSITY_none_ID)),            dimension(:),   allocatable, public, protected :: &
-   porosity_type                                                                                    !< porosity evolution model
- integer(kind(HYDROGENFLUX_isoconc_ID)),     dimension(:),   allocatable, public, protected :: &
-   hydrogenflux_type                                                                                !< hydrogen transport model
 
  integer(kind(SOURCE_undefined_ID)),         dimension(:,:), allocatable, public, protected :: &
    phase_source, &                                                                                  !< active sources mechanisms of each phase
@@ -181,17 +141,11 @@ module material
    homogenization_typeInstance, &                                                                   !< instance of particular type of each homogenization
    thermal_typeInstance, &                                                                          !< instance of particular type of each thermal transport
    damage_typeInstance, &                                                                           !< instance of particular type of each nonlocal damage
-   vacancyflux_typeInstance, &                                                                      !< instance of particular type of each vacancy flux
-   porosity_typeInstance, &                                                                         !< instance of particular type of each porosity model
-   hydrogenflux_typeInstance, &                                                                     !< instance of particular type of each hydrogen flux
    microstructure_crystallite                                                                       !< crystallite setting ID of each microstructure ! DEPRECATED !!!!
 
  real(pReal), dimension(:), allocatable, public, protected :: &
    thermal_initialT, &                                                                              !< initial temperature per each homogenization
-   damage_initialPhi, &                                                                             !< initial damage per each homogenization
+   damage_initialPhi                                                                                !< initial damage per each homogenization
-   vacancyflux_initialCv, &                                                                         !< initial vacancy concentration per each homogenization
-   porosity_initialPhi, &                                                                           !< initial posority per each homogenization
-   hydrogenflux_initialCh                                                                           !< initial hydrogen concentration per each homogenization
 
 ! NEW MAPPINGS 
  integer(pInt), dimension(:), allocatable, public, protected :: &
@@ -221,10 +175,7 @@ module material
  type(tState),        allocatable, dimension(:), public :: &
    homogState, &
    thermalState, &
-   damageState, &
+   damageState
-   vacancyfluxState, &
-   porosityState, &
-   hydrogenfluxState
 
  integer(pInt), dimension(:,:,:), allocatable, public, protected :: &
    material_texture                                                                                 !< texture (index) of each grain,IP,element
@@ -274,20 +225,12 @@ module material
 
  type(tHomogMapping), allocatable, dimension(:), public :: &
    thermalMapping, &                                                                                !< mapping for thermal state/fields
-   damageMapping, &                                                                                 !< mapping for damage state/fields
+   damageMapping                                                                                    !< mapping for damage state/fields
-   vacancyfluxMapping, &                                                                            !< mapping for vacancy conc state/fields
-   porosityMapping, &                                                                               !< mapping for porosity state/fields
-   hydrogenfluxMapping                                                                              !< mapping for hydrogen conc state/fields
 
  type(group_float),  allocatable, dimension(:), public :: &
    temperature, &                                                                                   !< temperature field
    damage, &                                                                                        !< damage field
-   vacancyConc, &                                                                                   !< vacancy conc field
+   temperatureRate                                                                                  !< temperature change rate field
-   porosity, &                                                                                      !< porosity field
-   hydrogenConc, &                                                                                  !< hydrogen conc field
-   temperatureRate, &                                                                               !< temperature change rate field
-   vacancyConcRate, &                                                                               !< vacancy conc change field
-   hydrogenConcRate                                                                                 !< hydrogen conc change field
 
  public :: &
    material_init, &
@@ -306,29 +249,16 @@ module material
    SOURCE_damage_isoDuctile_ID, &
    SOURCE_damage_anisoBrittle_ID, &
    SOURCE_damage_anisoDuctile_ID, &
-   SOURCE_vacancy_phenoplasticity_ID, &
-   SOURCE_vacancy_irradiation_ID, &
-   SOURCE_vacancy_thermalfluc_ID, &
    KINEMATICS_cleavage_opening_ID, &
    KINEMATICS_slipplane_opening_ID, &
    KINEMATICS_thermal_expansion_ID, &
-   KINEMATICS_vacancy_strain_ID, &
-   KINEMATICS_hydrogen_strain_ID, &
    STIFFNESS_DEGRADATION_damage_ID, &
-   STIFFNESS_DEGRADATION_porosity_ID, &
    THERMAL_isothermal_ID, &
    THERMAL_adiabatic_ID, &
    THERMAL_conduction_ID, &
    DAMAGE_none_ID, &
    DAMAGE_local_ID, &
    DAMAGE_nonlocal_ID, &
-   VACANCYFLUX_isoconc_ID, &
-   VACANCYFLUX_isochempot_ID, &
-   VACANCYFLUX_cahnhilliard_ID, &
-   POROSITY_none_ID, &
-   POROSITY_phasefield_ID, &
-   HYDROGENFLUX_isoconc_ID, &
-   HYDROGENFLUX_cahnhilliard_ID, &
    HOMOGENIZATION_none_ID, &
    HOMOGENIZATION_isostrain_ID, &
    HOMOGENIZATION_RGC_ID
@@ -397,19 +327,19 @@ subroutine material_init()
 #include "compilation_info.f90"
 
  call material_parsePhase()
- if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6)
+ if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase          parsed'; flush(6)
  
  call material_parseMicrostructure()
  if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
  
  call material_parseCrystallite()
- if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6)
+ if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite    parsed'; flush(6)
  
  call material_parseHomogenization()
  if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
  
  call material_parseTexture()
- if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6)
+ if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture        parsed'; flush(6)
 
  allocate(plasticState       (size(config_phase)))
  allocate(sourceState        (size(config_phase)))
@@ -420,25 +350,14 @@ subroutine material_init()
  allocate(homogState         (size(config_homogenization)))
  allocate(thermalState       (size(config_homogenization)))
  allocate(damageState        (size(config_homogenization)))
- allocate(vacancyfluxState   (size(config_homogenization)))
- allocate(porosityState      (size(config_homogenization)))
- allocate(hydrogenfluxState  (size(config_homogenization)))
 
  allocate(thermalMapping     (size(config_homogenization)))
  allocate(damageMapping      (size(config_homogenization)))
- allocate(vacancyfluxMapping (size(config_homogenization)))
- allocate(porosityMapping    (size(config_homogenization)))
- allocate(hydrogenfluxMapping(size(config_homogenization)))
 
  allocate(temperature        (size(config_homogenization)))
  allocate(damage             (size(config_homogenization)))
- allocate(vacancyConc        (size(config_homogenization)))
- allocate(porosity           (size(config_homogenization)))
- allocate(hydrogenConc       (size(config_homogenization)))
 
  allocate(temperatureRate    (size(config_homogenization)))
- allocate(vacancyConcRate    (size(config_homogenization)))
- allocate(hydrogenConcRate   (size(config_homogenization)))
 
  do m = 1_pInt,size(config_microstructure)
    if(microstructure_crystallite(m) < 1_pInt .or. &
@@ -511,17 +430,9 @@ subroutine material_init()
  do myHomog = 1,size(config_homogenization)
    thermalMapping     (myHomog)%p => mappingHomogenizationConst
    damageMapping      (myHomog)%p => mappingHomogenizationConst
-   vacancyfluxMapping (myHomog)%p => mappingHomogenizationConst
-   porosityMapping    (myHomog)%p => mappingHomogenizationConst
-   hydrogenfluxMapping(myHomog)%p => mappingHomogenizationConst
    allocate(temperature     (myHomog)%p(1), source=thermal_initialT(myHomog))
    allocate(damage          (myHomog)%p(1), source=damage_initialPhi(myHomog))
-   allocate(vacancyConc     (myHomog)%p(1), source=vacancyflux_initialCv(myHomog))
-   allocate(porosity        (myHomog)%p(1), source=porosity_initialPhi(myHomog))
-   allocate(hydrogenConc    (myHomog)%p(1), source=hydrogenflux_initialCh(myHomog))
    allocate(temperatureRate (myHomog)%p(1), source=0.0_pReal)
-   allocate(vacancyConcRate (myHomog)%p(1), source=0.0_pReal)
-   allocate(hydrogenConcRate(myHomog)%p(1), source=0.0_pReal)
  enddo
 
 end subroutine material_init
@@ -545,23 +456,14 @@ subroutine material_parseHomogenization
  allocate(homogenization_type(size(config_homogenization)),           source=HOMOGENIZATION_undefined_ID)
  allocate(thermal_type(size(config_homogenization)),                  source=THERMAL_isothermal_ID)
  allocate(damage_type (size(config_homogenization)),                  source=DAMAGE_none_ID)
- allocate(vacancyflux_type(size(config_homogenization)),              source=VACANCYFLUX_isoconc_ID)
- allocate(porosity_type (size(config_homogenization)),                source=POROSITY_none_ID)
- allocate(hydrogenflux_type(size(config_homogenization)),             source=HYDROGENFLUX_isoconc_ID)
  allocate(homogenization_typeInstance(size(config_homogenization)),   source=0_pInt)
  allocate(thermal_typeInstance(size(config_homogenization)),          source=0_pInt)
  allocate(damage_typeInstance(size(config_homogenization)),           source=0_pInt)
- allocate(vacancyflux_typeInstance(size(config_homogenization)),      source=0_pInt)
- allocate(porosity_typeInstance(size(config_homogenization)),         source=0_pInt)
- allocate(hydrogenflux_typeInstance(size(config_homogenization)),     source=0_pInt)
  allocate(homogenization_Ngrains(size(config_homogenization)),        source=0_pInt)
  allocate(homogenization_Noutput(size(config_homogenization)),        source=0_pInt)
  allocate(homogenization_active(size(config_homogenization)),         source=.false.)  !!!!!!!!!!!!!!!
  allocate(thermal_initialT(size(config_homogenization)),              source=300.0_pReal)
  allocate(damage_initialPhi(size(config_homogenization)),             source=1.0_pReal)
- allocate(vacancyflux_initialCv(size(config_homogenization)),         source=0.0_pReal)
- allocate(porosity_initialPhi(size(config_homogenization)),           source=1.0_pReal)
- allocate(hydrogenflux_initialCh(size(config_homogenization)),        source=0.0_pReal)
 
  forall (h = 1_pInt:size(config_homogenization)) &
    homogenization_active(h) = any(mesh_homogenizationAt == h)
@@ -621,62 +523,12 @@ subroutine material_parseHomogenization
 
    endif
 
-   if (config_homogenization(h)%keyExists('vacancyflux')) then
-     vacancyflux_initialCv(h) = config_homogenization(h)%getFloat('cv0',defaultVal=0.0_pReal)
-
-     tag = config_homogenization(h)%getString('vacancyflux')
-     select case (trim(tag))
-       case(VACANCYFLUX_isoconc_label)
-         vacancyflux_type(h) = VACANCYFLUX_isoconc_ID
-       case(VACANCYFLUX_isochempot_label)
-         vacancyflux_type(h) = VACANCYFLUX_isochempot_ID
-       case(VACANCYFLUX_cahnhilliard_label)
-         vacancyflux_type(h) = VACANCYFLUX_cahnhilliard_ID
-       case default
-         call IO_error(500_pInt,ext_msg=trim(tag))
-     end select
-   
-   endif
-
-   if (config_homogenization(h)%keyExists('porosity')) then
-     !ToDo?
-
-     tag = config_homogenization(h)%getString('porosity')
-     select case (trim(tag))
-       case(POROSITY_NONE_label)
-         porosity_type(h) = POROSITY_none_ID
-       case(POROSITY_phasefield_label)
-         porosity_type(h) = POROSITY_phasefield_ID
-       case default
-         call IO_error(500_pInt,ext_msg=trim(tag))
-      end select
-
-   endif
-
-   if (config_homogenization(h)%keyExists('hydrogenflux')) then
-     hydrogenflux_initialCh(h) = config_homogenization(h)%getFloat('ch0',defaultVal=0.0_pReal)
-
-     tag = config_homogenization(h)%getString('hydrogenflux')
-     select case (trim(tag))
-       case(HYDROGENFLUX_isoconc_label)
-         hydrogenflux_type(h) = HYDROGENFLUX_isoconc_ID
-       case(HYDROGENFLUX_cahnhilliard_label)
-         hydrogenflux_type(h) = HYDROGENFLUX_cahnhilliard_ID
-       case default
-         call IO_error(500_pInt,ext_msg=trim(tag))
-     end select
-
-   endif
-
  enddo
 
  do h=1_pInt, size(config_homogenization)
    homogenization_typeInstance(h)  = count(homogenization_type(1:h)  == homogenization_type(h))
    thermal_typeInstance(h)         = count(thermal_type       (1:h)  == thermal_type       (h))
    damage_typeInstance(h)          = count(damage_type        (1:h)  == damage_type        (h))
-   vacancyflux_typeInstance(h)     = count(vacancyflux_type   (1:h)  == vacancyflux_type   (h))
-   porosity_typeInstance(h)        = count(porosity_type      (1:h)  == porosity_type      (h))
-   hydrogenflux_typeInstance(h)    = count(hydrogenflux_type  (1:h)  == hydrogenflux_type  (h))
  enddo
 
  homogenization_maxNgrains = maxval(homogenization_Ngrains,homogenization_active)
@@ -866,12 +718,6 @@ subroutine material_parsePhase
          phase_source(sourceCtr,p) = SOURCE_damage_anisoBrittle_ID
        case (SOURCE_damage_anisoDuctile_label)
          phase_source(sourceCtr,p) = SOURCE_damage_anisoDuctile_ID
-       case (SOURCE_vacancy_phenoplasticity_label)
-         phase_source(sourceCtr,p) = SOURCE_vacancy_phenoplasticity_ID
-       case (SOURCE_vacancy_irradiation_label)
-         phase_source(sourceCtr,p) = SOURCE_vacancy_irradiation_ID
-       case (SOURCE_vacancy_thermalfluc_label)
-         phase_source(sourceCtr,p) = SOURCE_vacancy_thermalfluc_ID
      end select
    enddo
 
@@ -890,10 +736,6 @@ subroutine material_parsePhase
          phase_kinematics(kinematicsCtr,p) = KINEMATICS_slipplane_opening_ID
        case (KINEMATICS_thermal_expansion_label)
          phase_kinematics(kinematicsCtr,p) = KINEMATICS_thermal_expansion_ID
-       case (KINEMATICS_vacancy_strain_label)
-         phase_kinematics(kinematicsCtr,p) = KINEMATICS_vacancy_strain_ID
-       case (KINEMATICS_hydrogen_strain_label)
-         phase_kinematics(kinematicsCtr,p) = KINEMATICS_hydrogen_strain_ID
      end select
    enddo
 #if defined(__GFORTRAN__)
@@ -907,8 +749,6 @@ subroutine material_parsePhase
      select case (trim(str(stiffDegradationCtr)))
        case (STIFFNESS_DEGRADATION_damage_label)
          phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID
-       case (STIFFNESS_DEGRADATION_porosity_label)
-         phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_porosity_ID
     end select
    enddo
  enddo
@@ -1078,7 +918,8 @@ end subroutine material_parseTexture
 !--------------------------------------------------------------------------------------------------
 !> @brief allocates the plastic state of a phase
 !--------------------------------------------------------------------------------------------------
-subroutine material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState,&
+subroutine material_allocatePlasticState(phase,NofMyPhase,&
+                                         sizeState,sizeDotState,sizeDeltaState,&
                                          Nslip,Ntwin,Ntrans)
  use numerics, only: &
    numerics_integrator2 => numerics_integrator                                                      ! compatibility hack
@@ -1096,9 +937,10 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState
  integer(pInt) :: numerics_integrator                                                               ! compatibility hack
  numerics_integrator = numerics_integrator2(1)                                                      ! compatibility hack
 
- plasticState(phase)%sizeState      = sizeState
+ plasticState(phase)%sizeState        = sizeState
- plasticState(phase)%sizeDotState   = sizeDotState
+ plasticState(phase)%sizeDotState     = sizeDotState
- plasticState(phase)%sizeDeltaState = sizeDeltaState
+ plasticState(phase)%sizeDeltaState   = sizeDeltaState
+ plasticState(phase)%offsetDeltaState = sizeState-sizeDeltaState                                    ! deltaState occupies latter part of state by definition
  plasticState(phase)%Nslip = Nslip
  plasticState(phase)%Ntwin = Ntwin
  plasticState(phase)%Ntrans= Ntrans

src/math.f90

@@ -24,25 +24,25 @@ module math
      0.0_pReal,0.0_pReal,1.0_pReal  &
      ],[3,3])                                                                                       !< 3x3 Identity
 
+ real(pReal), dimension(6), parameter, private :: &
+   nrmMandel = [&
+     1.0_pReal,       1.0_pReal,       1.0_pReal, &
+     sqrt(2.0_pReal), sqrt(2.0_pReal), sqrt(2.0_pReal) ]                                            !< weighting for Mandel notation (forward)
+
+ real(pReal), dimension(6), parameter , private :: &
+   invnrmMandel = [&
+     1.0_pReal,                 1.0_pReal,                 1.0_pReal, &
+     1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal) ]              !< weighting for Mandel notation (backward)
+
  integer(pInt), dimension (2,6), parameter, private :: &
-   mapMandel = reshape([&
+   mapNye = reshape([&
      1_pInt,1_pInt, &
      2_pInt,2_pInt, &
      3_pInt,3_pInt, &
      1_pInt,2_pInt, &
      2_pInt,3_pInt, &
      1_pInt,3_pInt  &
-     ],[2,6])                                                                                       !< arrangement in Mandel notation
+     ],[2,6])                                                                                       !< arrangement in Nye notation.
-
- real(pReal), dimension(6), parameter, private :: &
-   nrmMandel = [&
-     1.0_pReal,       1.0_pReal,       1.0_pReal, &
-     sqrt(2.0_pReal), sqrt(2.0_pReal), sqrt(2.0_pReal) ]                                            !< weighting for Mandel notation (forward)
-
- real(pReal), dimension(6), parameter , public :: &
-   invnrmMandel = [&
-     1.0_pReal,                 1.0_pReal,                 1.0_pReal, &
-     1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal), 1.0_pReal/sqrt(2.0_pReal) ]              !< weighting for Mandel notation (backward)
 
  integer(pInt), dimension (2,6), parameter, private :: &
    mapVoigt = reshape([&
@@ -54,10 +54,6 @@ module math
      1_pInt,2_pInt  &
      ],[2,6])                                                                                       !< arrangement in Voigt notation
 
- real(pReal), dimension(6), parameter, private :: &
-   nrmVoigt    = 1.0_pReal, &                                                                       !< weighting for Voigt notation (forward)
-   invnrmVoigt = 1.0_pReal                                                                          !< weighting for Voigt notation (backward)
-
  integer(pInt), dimension (2,9), parameter, private :: &
    mapPlain = reshape([&
      1_pInt,1_pInt, &
@@ -71,7 +67,60 @@ module math
      3_pInt,3_pInt  &
      ],[2,9])                                                                                       !< arrangement in Plain notation
      
+!--------------------------------------------------------------------------------------------------
+! Provide deprecated names for compatibility
+
+! ToDo MD: Our naming scheme was a little bit odd: We use essentially the re-ordering according to Nye
+! (convenient because Abaqus and Marc want to have 12 on position 4)
+! but weight the shear components according to Mandel (convenient for matrix multiplications)
+ 
+ interface math_Plain33to9
+   module procedure math_33to9
+ end interface math_Plain33to9
+ 
+ interface math_Plain9to33
+   module procedure math_9to33
+ end interface math_Plain9to33
+ 
+ interface math_Mandel33to6
+   module procedure math_sym33to6
+ end interface math_Mandel33to6
+ 
+  interface math_Mandel6to33
+   module procedure math_6toSym33
+ end interface math_Mandel6to33
+ 
+  interface math_Plain3333to99
+   module procedure math_3333to99
+ end interface math_Plain3333to99
+ 
+ interface math_Plain99to3333
+   module procedure math_99to3333
+ end interface math_Plain99to3333
+ 
+ interface math_Mandel3333to66
+   module procedure math_sym3333to66
+ end interface math_Mandel3333to66
+ 
+ interface math_Mandel66to3333
+   module procedure math_66toSym3333
+ end interface math_Mandel66to3333
+ 
  public :: &
+   math_Plain33to9, &
+   math_Plain9to33, &
+   math_Mandel33to6, &
+   math_Mandel6to33, &
+   math_Plain3333to99, &
+   math_Plain99to3333, &
+   math_Mandel3333to66, &
+   math_Mandel66to3333
+!---------------------------------------------------------------------------------------------------
+
+ public :: &
+#if defined(__PGI)
+   norm2, &
+#endif
    math_init, &
    math_qsort, &
    math_expand, &
@@ -99,6 +148,7 @@ module math
    math_invert33, &
    math_invSym3333, &
    math_invert, &
+   math_invert2, &
    math_symmetric33, &
    math_symmetric66, &
    math_skew33, &
@@ -108,16 +158,14 @@ module math
    math_equivStress33, &
    math_trace33, &
    math_det33, &
-   math_Plain33to9, &
+   math_33to9, &
-   math_Plain9to33, &
+   math_9to33, &
-   math_Mandel33to6, &
+   math_sym33to6, &
-   math_Mandel6to33, &
+   math_6toSym33, &
-   math_Plain3333to99, &
+   math_3333to99, &
-   math_Plain99to3333, &
+   math_99to3333, &
-   math_Mandel66toPlain66, &
+   math_sym3333to66, &
-   math_Plain66toMandel66, &
+   math_66toSym3333, &
-   math_Mandel3333to66, &
-   math_Mandel66to3333, &
    math_Voigt66to3333, &
    math_qRand, &
    math_qMul, &
@@ -306,20 +354,38 @@ end subroutine math_check
 
 !--------------------------------------------------------------------------------------------------
 !> @brief Quicksort algorithm for two-dimensional integer arrays
-! Sorting is done with respect to array(1,:)
+! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) linked to it.
-! and keeps array(2:N,:) linked to it.
+! default: sort=1
 !--------------------------------------------------------------------------------------------------
-recursive subroutine math_qsort(a, istart, iend)
+recursive subroutine math_qsort(a, istart, iend, sortDim)
 
  implicit none
  integer(pInt), dimension(:,:), intent(inout) :: a
- integer(pInt), intent(in) :: istart,iend
+ integer(pInt), intent(in),optional :: istart,iend, sortDim
- integer(pInt) :: ipivot
+ integer(pInt) :: ipivot,s,e,d
  
- if (istart < iend) then
+ if(present(istart)) then
-   ipivot = qsort_partition(a,istart, iend)
+   s = istart
-   call math_qsort(a, istart, ipivot-1_pInt)
+ else
-   call math_qsort(a, ipivot+1_pInt, iend)
+   s = lbound(a,2)
+ endif
+ 
+ if(present(iend)) then
+   e = iend
+ else
+   e = ubound(a,2)
+ endif
+ 
+  if(present(sortDim)) then
+   d = sortDim
+ else
+   d = 1
+ endif
+  
+ if (s < e) then
+   ipivot = qsort_partition(a,s, e, d)
+   call math_qsort(a, s, ipivot-1_pInt, d)
+   call math_qsort(a, ipivot+1_pInt, e, d)
  endif
 
 !--------------------------------------------------------------------------------------------------
@@ -328,37 +394,34 @@ recursive subroutine math_qsort(a, istart, iend)
  !-------------------------------------------------------------------------------------------------
  !> @brief Partitioning required for quicksort
  !-------------------------------------------------------------------------------------------------
- integer(pInt) function qsort_partition(a, istart, iend)
+ integer(pInt) function qsort_partition(a, istart, iend, sort)
  
    implicit none
    integer(pInt), dimension(:,:), intent(inout) :: a
-   integer(pInt), intent(in) :: istart,iend
+   integer(pInt),                 intent(in)    :: istart,iend,sort
-   integer(pInt) :: i,j,k,tmp
+   integer(pInt), dimension(size(a,1))          :: tmp
+   integer(pInt) :: i,j
   
    do
-  ! find the first element on the right side less than or equal to the pivot point
+     ! find the first element on the right side less than or equal to the pivot point
      do j = iend, istart, -1_pInt
-       if (a(1,j) <= a(1,istart)) exit
+       if (a(sort,j) <= a(sort,istart)) exit
      enddo
-  ! find the first element on the left side greater than the pivot point
+     ! find the first element on the left side greater than the pivot point
      do i = istart, iend
-       if (a(1,i) > a(1,istart)) exit
+       if (a(sort,i) > a(sort,istart)) exit
      enddo
-     if (i < j) then ! if the indexes do not cross, exchange values
+     cross: if (i >= j) then ! if the indices cross, exchange left value with pivot and return with the partition index
-       do k = 1_pInt, int(size(a,1_pInt), pInt)
+       tmp         = a(:,istart)
-         tmp = a(k,i)
+       a(:,istart) = a(:,j)
-         a(k,i) = a(k,j)
+       a(:,j)      = tmp
-         a(k,j) = tmp
-       enddo
-     else           ! if they do cross, exchange left value with pivot and return with the partition index
-       do k = 1_pInt, int(size(a,1_pInt), pInt)
-         tmp = a(k,istart)
-         a(k,istart) = a(k,j)
-         a(k,j) = tmp
-       enddo
        qsort_partition = j
        return
-     endif
+     else cross ! if they do not cross, exchange values
+       tmp    = a(:,i)
+       a(:,i) = a(:,j)
+       a(:,j) = tmp
+     endif cross
    enddo
  
  end function qsort_partition
@@ -415,7 +478,7 @@ pure function math_identity2nd(dimen)
  real(pReal), dimension(dimen,dimen) :: math_identity2nd
 
  math_identity2nd = 0.0_pReal
- forall (i=1_pInt:dimen) math_identity2nd(i,i) = 1.0_pReal
+ forall(i=1_pInt:dimen) math_identity2nd(i,i) = 1.0_pReal
 
 end function math_identity2nd
 
@@ -429,9 +492,11 @@ pure function math_identity4th(dimen)
  integer(pInt), intent(in) :: dimen                                                                 !< tensor dimension
  integer(pInt) :: i,j,k,l
  real(pReal), dimension(dimen,dimen,dimen,dimen) ::  math_identity4th
+ real(pReal), dimension(dimen,dimen)             ::  identity2nd
 
- forall (i=1_pInt:dimen,j=1_pInt:dimen,k=1_pInt:dimen,l=1_pInt:dimen) math_identity4th(i,j,k,l) = &
+ identity2nd = math_identity2nd(dimen)
-        0.5_pReal*(math_I3(i,k)*math_I3(j,l)+math_I3(i,l)*math_I3(j,k))
+ forall(i=1_pInt:dimen,j=1_pInt:dimen,k=1_pInt:dimen,l=1_pInt:dimen) &
+   math_identity4th(i,j,k,l) = 0.5_pReal*(identity2nd(i,k)*identity2nd(j,l)+identity2nd(i,l)*identity2nd(j,k))
 
 end function math_identity4th
 
@@ -500,7 +565,7 @@ pure function math_tensorproduct(A,B)
  real(pReal), dimension(size(A,1),size(B,1)) ::  math_tensorproduct
  integer(pInt) :: i,j
 
- forall (i=1_pInt:size(A,1),j=1_pInt:size(B,1)) math_tensorproduct(i,j) = A(i)*B(j)
+ forall(i=1_pInt:size(A,1),j=1_pInt:size(B,1)) math_tensorproduct(i,j) = A(i)*B(j)
 
 end function math_tensorproduct
 
@@ -515,7 +580,7 @@ pure function math_tensorproduct33(A,B)
  real(pReal), dimension(3), intent(in) ::  A,B
  integer(pInt) :: i,j
 
- forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) math_tensorproduct33(i,j) = A(i)*B(j)
+ forall(i=1_pInt:3_pInt,j=1_pInt:3_pInt) math_tensorproduct33(i,j) = A(i)*B(j)
 
 end function math_tensorproduct33
 
@@ -556,7 +621,7 @@ real(pReal) pure function math_mul33xx33(A,B)
  integer(pInt) :: i,j
  real(pReal), dimension(3,3) ::              C
 
- forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) C(i,j) = A(i,j) * B(i,j)
+ forall(i=1_pInt:3_pInt,j=1_pInt:3_pInt) C(i,j) = A(i,j) * B(i,j)
  math_mul33xx33 = sum(C)
 
 end function math_mul33xx33
@@ -573,8 +638,7 @@ pure function math_mul3333xx33(A,B)
  real(pReal), dimension(3,3), intent(in) ::  B
  integer(pInt) :: i,j 
 
- forall(i = 1_pInt:3_pInt,j = 1_pInt:3_pInt) &
+ forall(i = 1_pInt:3_pInt,j = 1_pInt:3_pInt) math_mul3333xx33(i,j) = sum(A(i,j,1:3,1:3)*B(1:3,1:3))
-   math_mul3333xx33(i,j) = sum(A(i,j,1:3,1:3)*B(1:3,1:3))
 
 end function math_mul3333xx33
 
@@ -606,8 +670,7 @@ pure function math_mul33x33(A,B)
  real(pReal), dimension(3,3), intent(in) ::  A,B
  integer(pInt) :: i,j
 
- forall (i=1_pInt:3_pInt,j=1_pInt:3_pInt) &
+ forall(i=1_pInt:3_pInt,j=1_pInt:3_pInt) math_mul33x33(i,j) = A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j)
-   math_mul33x33(i,j) = A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j)
 
 end function math_mul33x33
 
@@ -622,9 +685,9 @@ pure function math_mul66x66(A,B)
  real(pReal), dimension(6,6), intent(in) ::  A,B
  integer(pInt) :: i,j
 
- forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt) math_mul66x66(i,j) = &
+ forall(i=1_pInt:6_pInt,j=1_pInt:6_pInt) &
-   A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j) + &
+   math_mul66x66(i,j) = A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j) &
-   A(i,4)*B(4,j) + A(i,5)*B(5,j) + A(i,6)*B(6,j)
+                      + A(i,4)*B(4,j) + A(i,5)*B(5,j) + A(i,6)*B(6,j)
 
 end function math_mul66x66
 
@@ -639,10 +702,10 @@ pure function math_mul99x99(A,B)
  real(pReal), dimension(9,9), intent(in) ::  A,B
  integer(pInt)  i,j
 
- forall (i=1_pInt:9_pInt,j=1_pInt:9_pInt) math_mul99x99(i,j) = &
+ forall(i=1_pInt:9_pInt,j=1_pInt:9_pInt) &
-   A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j) + &
+   math_mul99x99(i,j) = A(i,1)*B(1,j) + A(i,2)*B(2,j) + A(i,3)*B(3,j) &
-   A(i,4)*B(4,j) + A(i,5)*B(5,j) + A(i,6)*B(6,j) + &
+                      + A(i,4)*B(4,j) + A(i,5)*B(5,j) + A(i,6)*B(6,j) &
-   A(i,7)*B(7,j) + A(i,8)*B(8,j) + A(i,9)*B(9,j)
+                      + A(i,7)*B(7,j) + A(i,8)*B(8,j) + A(i,9)*B(9,j)
 
 end function math_mul99x99
 
@@ -690,9 +753,8 @@ pure function math_mul66x6(A,B)
  real(pReal), dimension(6),   intent(in) ::  B
  integer(pInt) :: i
 
- forall (i=1_pInt:6_pInt) math_mul66x6(i) = &
+ forall (i=1_pInt:6_pInt) math_mul66x6(i) = A(i,1)*B(1) + A(i,2)*B(2) + A(i,3)*B(3) &
-   A(i,1)*B(1) + A(i,2)*B(2) + A(i,3)*B(3) + &
+                                          + A(i,4)*B(4) + A(i,5)*B(5) + A(i,6)*B(6)
-   A(i,4)*B(4) + A(i,5)*B(5) + A(i,6)*B(6)
 
 end function math_mul66x6
 
@@ -739,8 +801,8 @@ end function math_transpose33
 
 !--------------------------------------------------------------------------------------------------
 !> @brief Cramer inversion of 33 matrix (function)
-!   direct Cramer inversion of matrix A.
+!> @details Direct Cramer inversion of matrix A. Returns all zeroes if not possible, i.e. 
-!   returns all zeroes if not possible, i.e. if det close to zero
+! if determinant is close to zero
 !--------------------------------------------------------------------------------------------------
 pure function math_inv33(A)
  use prec, only: &
@@ -776,9 +838,9 @@ end function math_inv33
 
 !--------------------------------------------------------------------------------------------------
 !> @brief Cramer inversion of 33 matrix (subroutine)
-!   direct Cramer inversion of matrix A.
+!> @details Direct Cramer inversion of matrix A. Also returns determinant
-!   also returns determinant
+!  Returns an error if not possible, i.e. if determinant is close to zero
-!   returns error if not possible, i.e. if det close to zero
+! ToDo: Output arguments should be first
 !--------------------------------------------------------------------------------------------------
 pure subroutine math_invert33(A, InvA, DetA, error)
  use prec, only: &
@@ -835,11 +897,11 @@ function math_invSym3333(A)
   dgetrf, &
   dgetri
 
- temp66_real = math_Mandel3333to66(A)
+ temp66_real = math_sym3333to66(A)
  call dgetrf(6,6,temp66_real,6,ipiv6,ierr)
  call dgetri(6,temp66_real,6,ipiv6,work6,6,ierr)
  if (ierr == 0_pInt) then
-   math_invSym3333 = math_Mandel66to3333(temp66_real)
+   math_invSym3333 = math_66toSym3333(temp66_real)
  else
    call IO_error(400_pInt, ext_msg = 'math_invSym3333')
  endif
@@ -847,8 +909,27 @@ function math_invSym3333(A)
 end function math_invSym3333
 
 
+!--------------------------------------------------------------------------------------------------
+!> @brief invert quadratic matrix of arbitrary dimension
+! ToDo: replaces math_invert
+!--------------------------------------------------------------------------------------------------
+subroutine math_invert2(InvA, error, A)
+
+ implicit none
+ real(pReal), dimension(:,:), intent(in)  :: A
+ 
+ real(pReal), dimension(size(A,1),size(A,1)), intent(out) :: invA
+ logical, intent(out) :: error
+
+ call math_invert(size(A,1), A, InvA, error)
+ 
+end subroutine math_invert2
+
+
 !--------------------------------------------------------------------------------------------------
 !> @brief invert matrix of arbitrary dimension
+! ToDo: Wrong order of arguments and superfluous myDim argument.
+! Use math_invert2 instead
 !--------------------------------------------------------------------------------------------------
 subroutine math_invert(myDim,A, InvA, error)
 
@@ -870,7 +951,7 @@ subroutine math_invert(myDim,A, InvA, error)
  invA = A 
  call dgetrf(myDim,myDim,invA,myDim,ipiv,ierr)
  call dgetri(myDim,InvA,myDim,ipiv,work,myDim,ierr)
- error = merge(.true.,.false., ierr /= 0_pInt)                                                      ! http://fortraninacworld.blogspot.de/2012/12/ternary-operator.html
+ error = merge(.true.,.false., ierr /= 0_pInt)
  
 end subroutine math_invert
 
@@ -953,15 +1034,14 @@ pure function math_equivStrain33(m)
  real(pReal), dimension(3,3), intent(in) :: m
  real(pReal), dimension(3) :: e,s
  real(pReal) :: math_equivStrain33
- real(pReal), parameter :: TWOTHIRD = 2.0_pReal/3.0_pReal
 
  e = [2.0_pReal*m(1,1)-m(2,2)-m(3,3), &
       2.0_pReal*m(2,2)-m(3,3)-m(1,1), &
       2.0_pReal*m(3,3)-m(1,1)-m(2,2)]/3.0_pReal
  s = [m(1,2),m(2,3),m(1,3)]*2.0_pReal
 
- math_equivStrain33 = TWOTHIRD*(1.50_pReal*(sum(e**2.0_pReal)) + &
+ math_equivStrain33 = 2.0_pReal/3.0_pReal &
-                                0.75_pReal*(sum(s**2.0_pReal)))**(0.5_pReal)
+                    * (1.50_pReal*(sum(e**2.0_pReal))+ 0.75_pReal*(sum(s**2.0_pReal)))**(0.5_pReal)
 
 end function math_equivStrain33
 
@@ -1033,173 +1113,188 @@ end function  math_detSym33
 !--------------------------------------------------------------------------------------------------
 !> @brief convert 33 matrix into vector 9
 !--------------------------------------------------------------------------------------------------
-pure function math_Plain33to9(m33)
+pure function math_33to9(m33)
 
  implicit none
- real(pReal), dimension(9) :: math_Plain33to9
+ real(pReal), dimension(9)               :: math_33to9
  real(pReal), dimension(3,3), intent(in) :: m33
+ 
  integer(pInt) :: i
 
- forall (i=1_pInt:9_pInt) math_Plain33to9(i) = m33(mapPlain(1,i),mapPlain(2,i))
+ forall(i=1_pInt:9_pInt) math_33to9(i) = m33(mapPlain(1,i),mapPlain(2,i))
 
-end function math_Plain33to9
+end function math_33to9
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief convert Plain 9 back to 33 matrix
+!> @brief convert 9 vector into 33 matrix
 !--------------------------------------------------------------------------------------------------
-pure function math_Plain9to33(v9)
+pure function math_9to33(v9)
 
  implicit none
- real(pReal), dimension(3,3) :: math_Plain9to33
+ real(pReal), dimension(3,3)           :: math_9to33
  real(pReal), dimension(9), intent(in) :: v9
+ 
  integer(pInt) :: i
 
- forall (i=1_pInt:9_pInt) math_Plain9to33(mapPlain(1,i),mapPlain(2,i)) = v9(i)
+ forall(i=1_pInt:9_pInt) math_9to33(mapPlain(1,i),mapPlain(2,i)) = v9(i)
 
-end function math_Plain9to33
+end function math_9to33
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief convert symmetric 33 matrix into Mandel vector 6
+!> @brief convert symmetric 33 matrix into 6 vector
+!> @details Weighted conversion (default) rearranges according to Nye and weights shear
+! components according to Mandel. Advisable for matrix operations.
+! Unweighted conversion only changes order according to Nye
 !--------------------------------------------------------------------------------------------------
-pure function math_Mandel33to6(m33)
+pure function math_sym33to6(m33,weighted)
 
  implicit none
- real(pReal), dimension(6) :: math_Mandel33to6
+ real(pReal), dimension(6)               :: math_sym33to6
  real(pReal), dimension(3,3), intent(in) :: m33
+ logical,     optional,       intent(in) :: weighted
  
+ real(pReal), dimension(6) :: w
  integer(pInt) :: i
  
- forall (i=1_pInt:6_pInt) math_Mandel33to6(i) = nrmMandel(i)*m33(mapMandel(1,i),mapMandel(2,i))
+ if(present(weighted)) then
+   w = merge(nrmMandel,1.0_pReal,weighted)
+ else
+   w = nrmMandel
+ endif
 
-end function math_Mandel33to6
+ forall(i=1_pInt:6_pInt) math_sym33to6(i) = w(i)*m33(mapNye(1,i),mapNye(2,i))
+
+end function math_sym33to6
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief convert Mandel 6 back to symmetric 33 matrix
+!> @brief convert 6 vector into symmetric 33 matrix
+!> @details Weighted conversion (default) rearranges according to Nye and weights shear
+! components according to Mandel. Advisable for matrix operations.
+! Unweighted conversion only changes order according to Nye
 !--------------------------------------------------------------------------------------------------
-pure function math_Mandel6to33(v6)
+pure function math_6toSym33(v6,weighted)
 
  implicit none
+ real(pReal), dimension(3,3)           :: math_6toSym33
  real(pReal), dimension(6), intent(in) :: v6
- real(pReal), dimension(3,3) :: math_Mandel6to33
+ logical,     optional,     intent(in) :: weighted
+
+ real(pReal), dimension(6) :: w
  integer(pInt) :: i
  
- forall (i=1_pInt:6_pInt)
+ if(present(weighted)) then
-  math_Mandel6to33(mapMandel(1,i),mapMandel(2,i)) = invnrmMandel(i)*v6(i)
+   w = merge(invnrmMandel,1.0_pReal,weighted)
-  math_Mandel6to33(mapMandel(2,i),mapMandel(1,i)) = invnrmMandel(i)*v6(i)
+ else
- end forall
+   w = invnrmMandel
+ endif
 
-end function math_Mandel6to33
+ do i=1_pInt,6_pInt
+   math_6toSym33(mapNye(1,i),mapNye(2,i)) = w(i)*v6(i)
+   math_6toSym33(mapNye(2,i),mapNye(1,i)) = w(i)*v6(i)
+ enddo
+
+end function math_6toSym33
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief convert 3333 tensor into plain matrix 99
+!> @brief convert 3333 matrix into 99 matrix
 !--------------------------------------------------------------------------------------------------
-pure function math_Plain3333to99(m3333)
+pure function math_3333to99(m3333)
 
  implicit none
+ real(pReal), dimension(9,9)                 :: math_3333to99
  real(pReal), dimension(3,3,3,3), intent(in) :: m3333
- real(pReal), dimension(9,9) :: math_Plain3333to99
+
  integer(pInt) :: i,j
 
- forall (i=1_pInt:9_pInt,j=1_pInt:9_pInt) math_Plain3333to99(i,j) = &
+ forall(i=1_pInt:9_pInt,j=1_pInt:9_pInt) &
-   m3333(mapPlain(1,i),mapPlain(2,i),mapPlain(1,j),mapPlain(2,j))
+   math_3333to99(i,j) = m3333(mapPlain(1,i),mapPlain(2,i),mapPlain(1,j),mapPlain(2,j))
+
+end function math_3333to99
 
-end function math_Plain3333to99
 
 !--------------------------------------------------------------------------------------------------
-!> @brief plain matrix 99 into 3333 tensor
+!> @brief convert 99 matrix into 3333 matrix
 !--------------------------------------------------------------------------------------------------
-pure function math_Plain99to3333(m99)
+pure function math_99to3333(m99)
 
  implicit none
+ real(pReal), dimension(3,3,3,3)         :: math_99to3333
  real(pReal), dimension(9,9), intent(in) :: m99
- real(pReal), dimension(3,3,3,3) :: math_Plain99to3333
+
  integer(pInt) :: i,j
 
- forall (i=1_pInt:9_pInt,j=1_pInt:9_pInt) math_Plain99to3333(mapPlain(1,i),mapPlain(2,i),&
+ forall(i=1_pInt:9_pInt,j=1_pInt:9_pInt) &
-   mapPlain(1,j),mapPlain(2,j)) = m99(i,j)
+   math_99to3333(mapPlain(1,i),mapPlain(2,i),mapPlain(1,j),mapPlain(2,j)) = m99(i,j)
 
-end function math_Plain99to3333
+end function math_99to3333
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief convert Mandel matrix 66 into Plain matrix 66
+!> @brief convert symmetric 3333 matrix into 66 matrix
+!> @details Weighted conversion (default) rearranges according to Nye and weights shear
+! components according to Mandel. Advisable for matrix operations.
+! Unweighted conversion only changes order according to Nye
 !--------------------------------------------------------------------------------------------------
-pure function math_Mandel66toPlain66(m66)
+pure function math_sym3333to66(m3333,weighted)
 
  implicit none
- real(pReal), dimension(6,6), intent(in) :: m66
+ real(pReal), dimension(6,6)                 :: math_sym3333to66
- real(pReal), dimension(6,6) :: math_Mandel66toPlain66
- integer(pInt) :: i,j
-
- forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt) &
-   math_Mandel66toPlain66(i,j) = invnrmMandel(i) * invnrmMandel(j) * m66(i,j)
-
-end function math_Mandel66toPlain66
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief convert Plain matrix 66 into Mandel matrix 66
-!--------------------------------------------------------------------------------------------------
-pure function math_Plain66toMandel66(m66)
-
- implicit none
- real(pReal), dimension(6,6), intent(in) :: m66
- real(pReal), dimension(6,6) :: math_Plain66toMandel66
- integer(pInt)  :: i,j
-
- forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt) &
-   math_Plain66toMandel66(i,j) = nrmMandel(i) * nrmMandel(j) * m66(i,j)
-
-end function math_Plain66toMandel66
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief convert symmetric 3333 tensor into Mandel matrix 66
-!--------------------------------------------------------------------------------------------------
-pure function math_Mandel3333to66(m3333)
-
- implicit none
-
  real(pReal), dimension(3,3,3,3), intent(in) :: m3333
- real(pReal), dimension(6,6) :: math_Mandel3333to66
+ logical,     optional,           intent(in) :: weighted
+
+ real(pReal), dimension(6) :: w
  integer(pInt) :: i,j
  
- forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt) math_Mandel3333to66(i,j) = &
+ if(present(weighted)) then
-   nrmMandel(i)*nrmMandel(j)*m3333(mapMandel(1,i),mapMandel(2,i),mapMandel(1,j),mapMandel(2,j))
+   w = merge(nrmMandel,1.0_pReal,weighted)
+ else
+   w = nrmMandel
+ endif
 
-end function math_Mandel3333to66
+ forall(i=1_pInt:6_pInt,j=1_pInt:6_pInt) &
+   math_sym3333to66(i,j) = w(i)*w(j)*m3333(mapNye(1,i),mapNye(2,i),mapNye(1,j),mapNye(2,j))
+
+end function math_sym3333to66
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief convert Mandel matrix 66 back to symmetric 3333 tensor
+!> @brief convert 66 matrix into symmetric 3333 matrix
+!> @details Weighted conversion (default) rearranges according to Nye and weights shear
+! components according to Mandel. Advisable for matrix operations.
+! Unweighted conversion only changes order according to Nye
 !--------------------------------------------------------------------------------------------------
-pure function math_Mandel66to3333(m66)
+pure function math_66toSym3333(m66,weighted)
 
  implicit none
- real(pReal), dimension(3,3,3,3) :: math_Mandel66to3333
+ real(pReal), dimension(3,3,3,3)            :: math_66toSym3333
- real(pReal), dimension(6,6), intent(in) :: m66
+ real(pReal), dimension(6,6),    intent(in) :: m66
+ logical,     optional,          intent(in) :: weighted
+ 
+ real(pReal), dimension(6) :: w
  integer(pInt) :: i,j
  
- forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt)
+ if(present(weighted)) then
-   math_Mandel66to3333(mapMandel(1,i),mapMandel(2,i),mapMandel(1,j),mapMandel(2,j)) = &
+   w = merge(invnrmMandel,1.0_pReal,weighted)
-                              invnrmMandel(i)*invnrmMandel(j)*m66(i,j)
+ else
-   math_Mandel66to3333(mapMandel(2,i),mapMandel(1,i),mapMandel(1,j),mapMandel(2,j)) = &
+   w = invnrmMandel
-                              invnrmMandel(i)*invnrmMandel(j)*m66(i,j)
+ endif
-   math_Mandel66to3333(mapMandel(1,i),mapMandel(2,i),mapMandel(2,j),mapMandel(1,j)) = &
-                              invnrmMandel(i)*invnrmMandel(j)*m66(i,j)
-   math_Mandel66to3333(mapMandel(2,i),mapMandel(1,i),mapMandel(2,j),mapMandel(1,j)) = &
-                              invnrmMandel(i)*invnrmMandel(j)*m66(i,j)
- end forall
 
-end function math_Mandel66to3333
+ do i=1_pInt,6_pInt; do j=1_pInt, 6_pInt
+   math_66toSym3333(mapNye(1,i),mapNye(2,i),mapNye(1,j),mapNye(2,j)) = w(i)*w(j)*m66(i,j)
+   math_66toSym3333(mapNye(2,i),mapNye(1,i),mapNye(1,j),mapNye(2,j)) = w(i)*w(j)*m66(i,j)
+   math_66toSym3333(mapNye(1,i),mapNye(2,i),mapNye(2,j),mapNye(1,j)) = w(i)*w(j)*m66(i,j)
+   math_66toSym3333(mapNye(2,i),mapNye(1,i),mapNye(2,j),mapNye(1,j)) = w(i)*w(j)*m66(i,j)
+ enddo; enddo
+
+end function math_66toSym3333
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief convert Voigt matrix 66 back to symmetric 3333 tensor
+!> @brief convert 66 Voigt matrix into symmetric 3333 matrix
 !--------------------------------------------------------------------------------------------------
 pure function math_Voigt66to3333(m66)
 
@@ -1208,16 +1303,12 @@ pure function math_Voigt66to3333(m66)
  real(pReal), dimension(6,6), intent(in) :: m66
  integer(pInt) :: i,j
 
- forall (i=1_pInt:6_pInt,j=1_pInt:6_pInt)
+ do i=1_pInt,6_pInt; do j=1_pInt, 6_pInt
-   math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(1,j),mapVoigt(2,j)) =  &
+   math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(1,j),mapVoigt(2,j)) = m66(i,j)
-                                                            invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j)
+   math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(1,j),mapVoigt(2,j)) = m66(i,j)
-   math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(1,j),mapVoigt(2,j)) = &
+   math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(2,j),mapVoigt(1,j)) = m66(i,j)
-                                                            invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j)
+   math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(2,j),mapVoigt(1,j)) = m66(i,j)
-   math_Voigt66to3333(mapVoigt(1,i),mapVoigt(2,i),mapVoigt(2,j),mapVoigt(1,j)) = &
+ enddo; enddo
-                                                            invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j)
-   math_Voigt66to3333(mapVoigt(2,i),mapVoigt(1,i),mapVoigt(2,j),mapVoigt(1,j)) = & 
-                                                            invnrmVoigt(i)*invnrmVoigt(j)*m66(i,j)
- end forall
 
 end function math_Voigt66to3333
 
@@ -1625,8 +1716,7 @@ pure function math_qToR(q)
  real(pReal), dimension(3,3) :: math_qToR, T,S
  integer(pInt) :: i, j
 
- forall (i = 1_pInt:3_pInt, j = 1_pInt:3_pInt) &
+ forall(i = 1_pInt:3_pInt, j = 1_pInt:3_pInt) T(i,j) = q(i+1_pInt) * q(j+1_pInt)
-   T(i,j) = q(i+1_pInt) * q(j+1_pInt)
 
  S = reshape( [0.0_pReal,     -q(4),      q(3), &
                     q(4), 0.0_pReal,     -q(2), &
@@ -1926,6 +2016,7 @@ end function math_symmetricEulers
 
 !--------------------------------------------------------------------------------------------------
 !> @brief eigenvalues and eigenvectors of symmetric matrix m
+! ToDo: has wrong oder of arguments
 !--------------------------------------------------------------------------------------------------
 subroutine math_eigenValuesVectorsSym(m,values,vectors,error)
 
@@ -1949,9 +2040,10 @@ end subroutine math_eigenValuesVectorsSym
 !--------------------------------------------------------------------------------------------------
 !> @brief eigenvalues and eigenvectors of symmetric 33 matrix m using an analytical expression
 !> and the general LAPACK powered version for arbritrary sized matrices as fallback
-!> @author Joachim Kopp, Max–Planck–Institut für Kernphysik, Heidelberg (Copyright (C) 2006)
+!> @author Joachim Kopp, Max-Planck-Institut für Kernphysik, Heidelberg (Copyright (C) 2006)
 !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
 !> @details See http://arxiv.org/abs/physics/0610206 (DSYEVH3)
+! ToDo: has wrong oder of arguments
 !--------------------------------------------------------------------------------------------------
 subroutine math_eigenValuesVectorsSym33(m,values,vectors)
  
@@ -2031,7 +2123,7 @@ end function math_eigenvectorBasisSym
 !--------------------------------------------------------------------------------------------------
 !> @brief eigenvector basis of symmetric 33 matrix m
 !--------------------------------------------------------------------------------------------------
-function math_eigenvectorBasisSym33(m)
+pure function math_eigenvectorBasisSym33(m)
 
  implicit none
  real(pReal), dimension(3,3)              :: math_eigenvectorBasisSym33
@@ -2096,7 +2188,7 @@ end function math_eigenvectorBasisSym33
 !--------------------------------------------------------------------------------------------------
 !> @brief logarithm eigenvector basis of symmetric 33 matrix m
 !--------------------------------------------------------------------------------------------------
-function math_eigenvectorBasisSym33_log(m)
+pure function math_eigenvectorBasisSym33_log(m)
 
  implicit none
  real(pReal), dimension(3,3)              :: math_eigenvectorBasisSym33_log
@@ -2152,11 +2244,12 @@ function math_eigenvectorBasisSym33_log(m)
  endif threeSimilarEigenvalues
 
  math_eigenvectorBasisSym33_log = log(sqrt(values(1))) * EB(1:3,1:3,1) &
-                            + log(sqrt(values(2))) * EB(1:3,1:3,2) &
+                                + log(sqrt(values(2))) * EB(1:3,1:3,2) &
-                            + log(sqrt(values(3))) * EB(1:3,1:3,3)
+                                + log(sqrt(values(3))) * EB(1:3,1:3,3)
 
 end function math_eigenvectorBasisSym33_log
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief rotational part from polar decomposition of 33 tensor m
 !--------------------------------------------------------------------------------------------------
@@ -2601,13 +2694,12 @@ pure function math_rotate_forward3333(tensor,rot_tensor)
  real(pReal), dimension(3,3,3,3), intent(in) :: tensor
  integer(pInt) :: i,j,k,l,m,n,o,p
 
- math_rotate_forward3333= 0.0_pReal
+ math_rotate_forward3333 = 0.0_pReal
-
+ do i = 1_pInt,3_pInt;do j = 1_pInt,3_pInt;do k = 1_pInt,3_pInt;do l = 1_pInt,3_pInt
- do i = 1_pInt,3_pInt; do j = 1_pInt,3_pInt; do k = 1_pInt,3_pInt; do l = 1_pInt,3_pInt
+ do m = 1_pInt,3_pInt;do n = 1_pInt,3_pInt;do o = 1_pInt,3_pInt;do p = 1_pInt,3_pInt
-   do m = 1_pInt,3_pInt; do n = 1_pInt,3_pInt; do o = 1_pInt,3_pInt; do p = 1_pInt,3_pInt
+   math_rotate_forward3333(i,j,k,l) &
-     math_rotate_forward3333(i,j,k,l) = math_rotate_forward3333(i,j,k,l) &
+     = math_rotate_forward3333(i,j,k,l) &
-                                      + rot_tensor(i,m) * rot_tensor(j,n) &
+     + rot_tensor(i,m) * rot_tensor(j,n) * rot_tensor(k,o) * rot_tensor(l,p) * tensor(m,n,o,p)
-                                      * rot_tensor(k,o) * rot_tensor(l,p) * tensor(m,n,o,p)
  enddo; enddo; enddo; enddo; enddo; enddo; enddo; enddo
 
 end function math_rotate_forward3333
@@ -2633,4 +2725,19 @@ real(pReal) pure elemental function math_clip(a, left, right)
 
 end function math_clip
 
+
+#if defined(__PGI)
+!--------------------------------------------------------------------------------------------------
+!> @brief substitute for the norm2 intrinsic which is not available in PGI 18.10
+!--------------------------------------------------------------------------------------------------
+real(pReal) pure function norm2(v)
+ 
+ implicit none
+ real(pReal), intent(in), dimension(3) :: v
+ 
+ norm2 = sqrt(sum(v**2))
+
+end function norm2
+#endif
+
 end module math

src/numerics.f90

@@ -276,8 +276,6 @@ subroutine numerics_init
          numerics_integrator = IO_intValue(line,chunkPos,2_pInt)
        case ('usepingpong')
          usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
-       case ('timesyncing')
-         numerics_timeSyncing = IO_intValue(line,chunkPos,2_pInt) > 0_pInt
        case ('unitlength')
          numerics_unitlength = IO_floatValue(line,chunkPos,2_pInt)
 
@@ -454,8 +452,6 @@ subroutine numerics_init
  end select
 #endif
 
- numerics_timeSyncing = numerics_timeSyncing .and. all(numerics_integrator==2_pInt)                 ! timeSyncing only allowed for explicit Euler integrator
-
 !--------------------------------------------------------------------------------------------------
 ! writing parameters to output
  write(6,'(a24,1x,es8.1)')  ' relevantStrain:         ',relevantStrain
@@ -476,7 +472,6 @@ subroutine numerics_init
  write(6,'(a24,1x,es8.1)')  ' rTol_crystalliteStress: ',rTol_crystalliteStress
  write(6,'(a24,1x,es8.1)')  ' aTol_crystalliteStress: ',aTol_crystalliteStress
  write(6,'(a24,2(1x,i8))')  ' integrator:             ',numerics_integrator
- write(6,'(a24,1x,L8)')     ' timeSyncing:            ',numerics_timeSyncing
  write(6,'(a24,1x,L8)')     ' use ping pong scheme:   ',usepingpong
  write(6,'(a24,1x,es8.1,/)')' unitlength:             ',numerics_unitlength
 

src/plastic_isotropic.f90

@@ -1,66 +1,69 @@
 !--------------------------------------------------------------------------------------------------
 !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
 !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for isotropic (ISOTROPIC) plasticity
+!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
-!> @details Isotropic (ISOTROPIC) Plasticity which resembles the phenopowerlaw plasticity without
+!> @brief material subroutine for isotropic plasticity
+!> @details Isotropic Plasticity which resembles the phenopowerlaw plasticity without
 !! resolving the stress on the slip systems. Will give the response of phenopowerlaw for an
 !! untextured polycrystal
 !--------------------------------------------------------------------------------------------------
 module plastic_isotropic
  use prec, only: &
-   pReal,&
+   pReal, &
    pInt
 
  implicit none
  private
  integer(pInt),                       dimension(:,:),   allocatable, target, public :: &
-   plastic_isotropic_sizePostResult                                                                   !< size of each post result output
+   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
+   plastic_isotropic_output                                                                         !< name of each post result output
- integer(pInt),                       dimension(:),     allocatable, target, public :: &
-   plastic_isotropic_Noutput                                                                          !< number of outputs per instance
 
  enum, bind(c)
-   enumerator :: undefined_ID, &
+   enumerator :: &
-                 flowstress_ID, &
+     undefined_ID, &
-                 strainrate_ID
+     flowstress_ID, &
+     strainrate_ID
  end enum
 
- type, private :: tParameters                                                                         !< container type for internal constitutive parameters
+ type, private :: tParameters
-   integer(kind(undefined_ID)), allocatable, dimension(:) :: & 
+   real(pReal) :: &
-     outputID
+     fTaylor, &                                                                                     !< Taylor factor
-  real(pReal) :: &
+     tau0, &                                                                                        !< initial critical stress
-     fTaylor, &
+     gdot0, &                                                                                       !< reference strain rate
-     tau0, &
+     n, &                                                                                           !< stress exponent
-     gdot0, &
-     n, &
      h0, &
      h0_slopeLnRate, &
-     tausat, &
+     tausat, &                                                                                      !< maximum critical stress
      a, &
-     aTolFlowstress, &
-     aTolShear, &
      tausat_SinhFitA, &
      tausat_SinhFitB, &
      tausat_SinhFitC, &
-     tausat_SinhFitD
+     tausat_SinhFitD, &
-  logical :: &
+     aTolFlowstress, &
+     aTolShear
+   integer(pInt) :: &
+     of_debug = 0_pInt
+   integer(kind(undefined_ID)), allocatable, dimension(:) :: &
+     outputID
+   logical :: &
      dilatation
- end type
+ end type tParameters
 
- type(tParameters), dimension(:), allocatable, target, private :: param                               !< containers of constitutive parameters (len Ninstance)
+ type, private :: tIsotropicState
- 
+   real(pReal), pointer, dimension(:) :: &
- type, private :: tIsotropicState                                                                     !< internal state aliases
-   real(pReal), pointer,     dimension(:) :: &                                                        ! scalars along NipcMyInstance
      flowstress, &
      accumulatedShear
- end type
+ end type tIsotropicState
 
- type(tIsotropicState), allocatable, dimension(:), private :: &                                       !< state aliases per instance
+!--------------------------------------------------------------------------------------------------
-   state, &
+! containers for parameters and state
-   dotState
+ type(tParameters),     allocatable, dimension(:), private :: param
+ type(tIsotropicState), allocatable, dimension(:), private :: &
+   dotState, &
+   state
 
- public  :: &
+ public :: &
    plastic_isotropic_init, &
    plastic_isotropic_LpAndItsTangent, &
    plastic_isotropic_LiAndItsTangent, &
@@ -69,7 +72,6 @@ module plastic_isotropic
 
 contains
 
-
 !--------------------------------------------------------------------------------------------------
 !> @brief module initialization
 !> @details reads in material parameters, allocates arrays, and does sanity checks
@@ -80,20 +82,29 @@ subroutine plastic_isotropic_init()
    compiler_version, &
    compiler_options
 #endif
-use IO
+ use prec, only: &
+   pStringLen
  use debug, only: &
+#ifdef DEBUG
+   debug_e, &
+   debug_i, &
+   debug_g, &
+   debug_levelExtensive, &
+#endif
    debug_level, &
    debug_constitutive, &
    debug_levelBasic
- use numerics, only: &
+ use IO, only: &
-   numerics_integrator
+   IO_error, &
- use math, only: &
+   IO_timeStamp
-   math_Mandel3333to66, &
-   math_Voigt66to3333
  use material, only: &
+#ifdef DEBUG
+   phasememberAt, &
+#endif
    phase_plasticity, &
    phase_plasticityInstance, &
    phase_Noutput, &
+   material_allocatePlasticState, &
    PLASTICITY_ISOTROPIC_label, &
    PLASTICITY_ISOTROPIC_ID, &
    material_phase, &
@@ -101,148 +112,142 @@ use IO
  use config, only: &
    MATERIAL_partPhase, &
    config_phase
-   
  use lattice
 
  implicit none
- 
- type(tParameters), pointer :: prm
- 
  integer(pInt) :: &
-   phase, & 
+   Ninstance, &
-   instance, &
+   p, i, &
-   maxNinstance, &
+   NipcMyPhase, &
-   sizeDotState, &
+   sizeState, sizeDotState
-   sizeState, &
-   sizeDeltaState
- character(len=65536) :: &
-   extmsg    = ''
- integer(pInt) :: NipcMyPhase,i
- character(len=65536), dimension(:), allocatable :: outputs
 
- write(6,'(/,a)')   ' <<<+-  constitutive_'//PLASTICITY_ISOTROPIC_label//' init  -+>>>'
+ character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
+
+ integer(kind(undefined_ID)) :: &
+   outputID
+
+ character(len=pStringLen) :: &
+   extmsg = ''
+ character(len=65536), dimension(:), allocatable :: &
+   outputs
+
+ write(6,'(/,a)')   ' <<<+-  plastic_'//PLASTICITY_ISOTROPIC_label//' init  -+>>>'
+ write(6,'(/,a)')   ' Maiti and Eisenlohr, Scripta Materialia, 145:37-40, 2018'
+ write(6,'(/,a)')   ' https://doi.org/10.1016/j.scriptamat.2017.09.047'
  write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
 #include "compilation_info.f90"
 
- maxNinstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt)
+ Ninstance = int(count(phase_plasticity == PLASTICITY_ISOTROPIC_ID),pInt)
  if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
-   write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
+   write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
 
-! public variables
+ allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
- allocate(plastic_isotropic_sizePostResult(maxval(phase_Noutput), maxNinstance),source=0_pInt)
+ allocate(plastic_isotropic_output(maxval(phase_Noutput),Ninstance))
- allocate(plastic_isotropic_output(maxval(phase_Noutput), maxNinstance))
           plastic_isotropic_output = ''
- allocate(plastic_isotropic_Noutput(maxNinstance),                              source=0_pInt)
 
- allocate(param(maxNinstance))                                                                      ! one container of parameters per instance
+ allocate(param(Ninstance))
- allocate(state(maxNinstance))                                                                      ! internal state aliases
+ allocate(state(Ninstance))
- allocate(dotState(maxNinstance))
+ allocate(dotState(Ninstance))
 
- do phase = 1_pInt, size(phase_plasticityInstance)
+ do p = 1_pInt, size(phase_plasticity)
-   if (phase_plasticity(phase) == PLASTICITY_ISOTROPIC_ID) then
+   if (phase_plasticity(p) /= PLASTICITY_ISOTROPIC_ID) cycle
-     instance = phase_plasticityInstance(phase)
+   associate(prm => param(phase_plasticityInstance(p)), &
-     prm => param(instance)                                                                         ! shorthand pointer to parameter object of my constitutive law
+             dot => dotState(phase_plasticityInstance(p)), &
-     prm%tau0            =  config_phase(phase)%getFloat('tau0')
+             stt => state(phase_plasticityInstance(p)), &
-     prm%tausat          =  config_phase(phase)%getFloat('tausat')
+             config => config_phase(p))
-     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/')
+#ifdef DEBUG
-
+   if  (p==material_phase(debug_g,debug_i,debug_e)) then
-#if defined(__GFORTRAN__)
+     prm%of_debug = phasememberAt(debug_g,debug_i,debug_e)
-     outputs = ['GfortranBug86277']
+   endif
-     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)
+   prm%tau0            = config%getFloat('tau0')
-       select case(outputs(i))
+   prm%tausat          = config%getFloat('tausat')
-         case ('flowstress')
+   prm%gdot0           = config%getFloat('gdot0')
-           plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
+   prm%n               = config%getFloat('n')
-           plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i)
+   prm%h0              = config%getFloat('h0')
-           plasticState(phase)%sizePostResults =  plasticState(phase)%sizePostResults + 1_pInt
+   prm%fTaylor         = config%getFloat('m')
-           plastic_isotropic_sizePostResult(i,instance) = 1_pInt
+   prm%h0_slopeLnRate  = config%getFloat('h0_slopelnrate', defaultVal=0.0_pReal)
-           prm%outputID = [prm%outputID,flowstress_ID]
+   prm%tausat_SinhFitA = config%getFloat('tausat_sinhfita',defaultVal=0.0_pReal)
-         case ('strainrate')
+   prm%tausat_SinhFitB = config%getFloat('tausat_sinhfitb',defaultVal=0.0_pReal)
-           plastic_isotropic_Noutput(instance) = plastic_isotropic_Noutput(instance) + 1_pInt
+   prm%tausat_SinhFitC = config%getFloat('tausat_sinhfitc',defaultVal=0.0_pReal)
-           plastic_isotropic_output(plastic_isotropic_Noutput(instance),instance) = outputs(i)
+   prm%tausat_SinhFitD = config%getFloat('tausat_sinhfitd',defaultVal=0.0_pReal)
-           plasticState(phase)%sizePostResults = &
+   prm%a               = config%getFloat('a')
-             plasticState(phase)%sizePostResults + 1_pInt
+   prm%aTolFlowStress  = config%getFloat('atol_flowstress',defaultVal=1.0_pReal)
-           plastic_isotropic_sizePostResult(i,instance) = 1_pInt
+   prm%aTolShear       = config%getFloat('atol_shear',     defaultVal=1.0e-6_pReal)
-           prm%outputID = [prm%outputID,strainrate_ID]
+
-       end select
+   prm%dilatation      = config%keyExists('/dilatation/')
-     enddo
 
 !--------------------------------------------------------------------------------------------------
 !  sanity checks
-     extmsg = ''
+   extmsg = ''
-     if (prm%aTolShear        <= 0.0_pReal) extmsg = trim(extmsg)//"'aTolShear' "
+   if (prm%aTolShear      <= 0.0_pReal) extmsg = trim(extmsg)//' aTolShear'
-     if (prm%tau0              < 0.0_pReal) extmsg = trim(extmsg)//"'tau0' "
+   if (prm%tau0            < 0.0_pReal) extmsg = trim(extmsg)//' tau0'
-     if (prm%gdot0            <= 0.0_pReal) extmsg = trim(extmsg)//"'gdot0' "
+   if (prm%gdot0          <= 0.0_pReal) extmsg = trim(extmsg)//' gdot0'
-     if (prm%n                <= 0.0_pReal) extmsg = trim(extmsg)//"'n' "
+   if (prm%n              <= 0.0_pReal) extmsg = trim(extmsg)//' n'
-     if (prm%tausat           <= prm%tau0)    extmsg = trim(extmsg)//"'tausat' "
+   if (prm%tausat         <= prm%tau0)  extmsg = trim(extmsg)//' tausat'
-     if (prm%a                <= 0.0_pReal) extmsg = trim(extmsg)//"'a' " 
+   if (prm%a              <= 0.0_pReal) extmsg = trim(extmsg)//' a'
-     if (prm%fTaylor          <= 0.0_pReal) extmsg = trim(extmsg)//"'m' "
+   if (prm%fTaylor        <= 0.0_pReal) extmsg = trim(extmsg)//' m'
-     if (prm%aTolFlowstress   <= 0.0_pReal) extmsg = trim(extmsg)//"'atol_flowstress' "
+   if (prm%aTolFlowstress <= 0.0_pReal) extmsg = trim(extmsg)//' atol_flowstress'
-     if (extmsg /= '') call IO_error(211_pInt,ip=instance,&
+   if (prm%aTolShear      <= 0.0_pReal) extmsg = trim(extmsg)//' atol_shear'
-                            ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')')
+
+!--------------------------------------------------------------------------------------------------
+!  exit if any parameter is out of range
+   if (extmsg /= '') &
+     call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//PLASTICITY_ISOTROPIC_label//')')
+
+!--------------------------------------------------------------------------------------------------
+!  output pararameters
+   outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
+   allocate(prm%outputID(0))
+   do i=1_pInt, size(outputs)
+     outputID = undefined_ID
+     select case(outputs(i))
+
+       case ('flowstress')
+         outputID = flowstress_ID
+       case ('strainrate')
+         outputID = strainrate_ID
+
+     end select
+
+     if (outputID /= undefined_ID) then
+       plastic_isotropic_output(i,phase_plasticityInstance(p)) = outputs(i)
+       plastic_isotropic_sizePostResult(i,phase_plasticityInstance(p)) = 1_pInt
+       prm%outputID = [prm%outputID, outputID]
+    endif
+
+   enddo
 
 !--------------------------------------------------------------------------------------------------
 ! allocate state arrays
-     NipcMyPhase = count(material_phase == phase)                                                   ! number of own material points (including point components ipc)
+   NipcMyPhase = count(material_phase == p)
+   sizeDotState = size(['flowstress       ','accumulated_shear'])
+   sizeState = sizeDotState
 
-     sizeDotState   = size(["flowstress       ","accumulated_shear"])
+   call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, &
-     sizeDeltaState = 0_pInt                                                                         ! no sudden jumps in state
+                                      1_pInt,0_pInt,0_pInt)
-     sizeState      = sizeDotState + sizeDeltaState
+   plasticState(p)%sizePostResults = sum(plastic_isotropic_sizePostResult(:,phase_plasticityInstance(p)))
-     plasticState(phase)%sizeState = sizeState
-     plasticState(phase)%sizeDotState = sizeDotState
-     plasticState(phase)%sizeDeltaState = sizeDeltaState
-     plasticState(phase)%nSlip = 1
-     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)
-     allocate(plasticState(phase)%dotState           (sizeDotState,NipcMyPhase),source=0.0_pReal)
-     allocate(plasticState(phase)%deltaState       (sizeDeltaState,NipcMyPhase),source=0.0_pReal)
-     if (any(numerics_integrator == 1_pInt)) then
-       allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal)
-       allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal)
-     endif
-     if (any(numerics_integrator == 4_pInt)) &
-       allocate(plasticState(phase)%RK4dotState      (sizeDotState,NipcMyPhase),source=0.0_pReal)
-     if (any(numerics_integrator == 5_pInt)) &
-       allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase),source=0.0_pReal)
 
 !--------------------------------------------------------------------------------------------------
 ! locally defined state aliases and initialization of state0 and aTolState
+   stt%flowstress  => plasticState(p)%state   (1,:)
+   stt%flowstress  = prm%tau0
+   dot%flowstress  => plasticState(p)%dotState(1,:)
+   plasticState(p)%aTolState(1) = prm%aTolFlowstress
 
-     state(instance)%flowstress             => plasticState(phase)%state    (1,1:NipcMyPhase)
+   stt%accumulatedShear  => plasticState(p)%state   (2,:)
-     dotState(instance)%flowstress          => plasticState(phase)%dotState (1,1:NipcMyPhase)
+   dot%accumulatedShear  => plasticState(p)%dotState(2,:)
-     plasticState(phase)%state0(1,1:NipcMyPhase) = prm%tau0
+   plasticState(p)%aTolState(2) = prm%aTolShear
-     plasticState(phase)%aTolState(1)       =  prm%aTolFlowstress
+   ! global alias
+   plasticState(p)%slipRate        => plasticState(p)%dotState(2:2,:)
+   plasticState(p)%accumulatedSlip => plasticState(p)%state   (2:2,:)
 
-     state(instance)%accumulatedShear       => plasticState(phase)%state    (2,1:NipcMyPhase)
+   plasticState(p)%state0 = plasticState(p)%state                                                   ! ToDo: this could be done centrally
-     dotState(instance)%accumulatedShear    => plasticState(phase)%dotState (2,1:NipcMyPhase)
+
-     plasticState(phase)%state0 (2,1:NipcMyPhase) = 0.0_pReal
+   end associate
-     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
  enddo
 
 end subroutine plastic_isotropic_init
@@ -251,309 +256,237 @@ end subroutine plastic_isotropic_init
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates plastic velocity gradient and its tangent
 !--------------------------------------------------------------------------------------------------
-subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el)
+subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
+#ifdef DEBUG
  use debug, only: &
    debug_level, &
-   debug_constitutive, &
+   debug_constitutive,&
-   debug_levelBasic, &
    debug_levelExtensive, &
-   debug_levelSelective, &
+   debug_levelSelective
-   debug_e, &
+#endif
-   debug_i, &
-   debug_g
  use math, only: &
-   math_mul6x6, &
-   math_Mandel6to33, &
-   math_Plain3333to99, &
    math_deviatoric33, &
    math_mul33xx33
- use material, only: &
-   phasememberAt, &
-   material_phase, &
-   phase_plasticityInstance
 
  implicit none
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pReal), dimension(3,3),     intent(out) :: &
    Lp                                                                                               !< plastic velocity gradient
- real(pReal), dimension(9,9), intent(out) :: &
+ real(pReal), dimension(3,3,3,3), intent(out) :: &
-   dLp_dTstar99                                                                                     !< derivative of Lp with respect to 2nd Piola Kirchhoff stress
+   dLp_dMp                                                                                          !< derivative of Lp with respect to the Mandel stress
 
- real(pReal), dimension(6),   intent(in) :: &
+ real(pReal), dimension(3,3), intent(in) :: &
-   Tstar_v                                                                                          !< 2nd Piola Kirchhoff stress tensor in Mandel notation
+   Mp                                                                                               !< Mandel stress
  integer(pInt),               intent(in) :: &
-   ipc, &                                                                                           !< component-ID of integration point
+   instance, &
-   ip, &                                                                                            !< integration point
+   of
-   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
+   Mp_dev                                                                                           !< deviatoric part of the Mandel stress
- real(pReal), dimension(3,3,3,3) :: &
-   dLp_dTstar_3333                                                                                  !< derivative of Lp with respect to Tstar as 4th order tensor
  real(pReal) :: &
    gamma_dot, &                                                                                     !< strainrate
-   norm_Tstar_dev, &                                                                                !< euclidean norm of Tstar_dev
+   norm_Mp_dev, &                                                                                   !< norm of the deviatoric part of the Mandel stress
-   squarenorm_Tstar_dev                                                                             !< square of the euclidean norm of Tstar_dev
+   squarenorm_Mp_dev                                                                                !< square of the norm of the deviatoric part of the Mandel stress
  integer(pInt) :: &
-   instance, of, &
    k, l, m, n
 
- of = phasememberAt(ipc,ip,el)                                                                      ! phasememberAt should be tackled by material and be renamed to material_phasemember
+ associate(prm => param(instance), stt => state(instance))
- 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
+ Mp_dev = math_deviatoric33(Mp)
- squarenorm_Tstar_dev = math_mul33xx33(Tstar_dev_33,Tstar_dev_33)
+ squarenorm_Mp_dev = math_mul33xx33(Mp_dev,Mp_dev)
- norm_Tstar_dev = sqrt(squarenorm_Tstar_dev) 
+ norm_Mp_dev = sqrt(squarenorm_Mp_dev)
 
- if (norm_Tstar_dev <= 0.0_pReal) then                                                              ! Tstar == 0 --> both Lp and dLp_dTstar are zero
+ if (norm_Mp_dev > 0.0_pReal) then
-   Lp = 0.0_pReal
+   gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Mp_dev/(prm%fTaylor*stt%flowstress(of))) **prm%n
-   dLp_dTstar99 = 0.0_pReal
- else
-   gamma_dot = prm%gdot0 &
-             * ( sqrt(1.5_pReal) * norm_Tstar_dev / prm%fTaylor / state(instance)%flowstress(of) ) &
-             **prm%n
-
-   Lp = Tstar_dev_33/norm_Tstar_dev * gamma_dot/prm%fTaylor 
 
+   Lp = Mp_dev/norm_Mp_dev * gamma_dot/prm%fTaylor
+#ifdef DEBUG
    if (iand(debug_level(debug_constitutive), debug_levelExtensive) /= 0_pInt &
-       .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) &
+       .and. (of == prm%of_debug .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then
-              .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', &
-                                      transpose(Tstar_dev_33(1:3,1:3))*1.0e-6_pReal
+                                      transpose(Mp_dev)*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 >> norm Tstar / MPa', norm_Mp_dev*1.0e-6_pReal
      write(6,'(/,a,/,f12.5)') '<< CONST isotropic >> gdot', gamma_dot
    end if
-!--------------------------------------------------------------------------------------------------
+#endif
-! 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) = (prm%n-1.0_pReal) * &
+     dLp_dMp(k,l,m,n) = (prm%n-1.0_pReal) * Mp_dev(k,l)*Mp_dev(m,n) / squarenorm_Mp_dev
-                                      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
+     dLp_dMp(k,l,k,l) = dLp_dMp(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_dMp(k,k,m,m) = dLp_dMp(k,k,m,m) - 1.0_pReal/3.0_pReal
-   dLp_dTstar99 = math_Plain3333to99(gamma_dot / prm%fTaylor * &
+   dLp_dMp = gamma_dot / prm%fTaylor * dLp_dMp / norm_Mp_dev
-                                      dLp_dTstar_3333 / norm_Tstar_dev)
+ else
+   Lp = 0.0_pReal
+   dLp_dMp = 0.0_pReal
  end if
+
+ end associate
+
 end subroutine plastic_isotropic_LpAndItsTangent
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates plastic velocity gradient and its tangent
+! ToDo: Rename Tstar to Mi?
 !--------------------------------------------------------------------------------------------------
-subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar_3333,Tstar_v,ipc,ip,el)
+subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of)
  use math, only: &
-   math_mul6x6, &
-   math_Mandel6to33, &
-   math_Plain3333to99, &
    math_spherical33, &
    math_mul33xx33
- use material, only: &
-   phasememberAt, &
-   material_phase, &
-   phase_plasticityInstance
 
  implicit none
  real(pReal), dimension(3,3), intent(out) :: &
-   Li                                                                                               !< plastic velocity gradient
+   Li                                                                                               !< inleastic velocity gradient
  real(pReal), dimension(3,3,3,3), intent(out)  :: &
-   dLi_dTstar_3333                                                                                  !< derivative of Li with respect to Tstar as 4th order tensor
+   dLi_dTstar                                                                                       !< derivative of Li with respect to the Mandel stress
- real(pReal), dimension(6),   intent(in) :: &
-   Tstar_v                                                                                          !< 2nd Piola Kirchhoff stress tensor in Mandel notation
- integer(pInt),               intent(in) :: &
-   ipc, &                                                                                           !< component-ID of integration point
-   ip, &                                                                                            !< integration point
-   el                                                                                               !< element
 
- type(tParameters), pointer :: prm
+ real(pReal), dimension(3,3),   intent(in) :: &
+   Tstar                                                                                            !< Mandel stress ToDo: Mi?
+ integer(pInt),                 intent(in) :: &
+   instance, &
+   of
 
  real(pReal), dimension(3,3) :: &
-   Tstar_sph_33                                                                                     !< sphiatoric part of the 2nd Piola Kirchhoff stress tensor as 2nd order tensor
+   Tstar_sph                                                                                        !< sphiatoric part of the Mandel stress
  real(pReal) :: &
    gamma_dot, &                                                                                     !< strainrate
    norm_Tstar_sph, &                                                                                !< euclidean norm of Tstar_sph
    squarenorm_Tstar_sph                                                                             !< square of the euclidean norm of Tstar_sph
  integer(pInt) :: &
-   instance, of, &
    k, l, m, n
 
- of = phasememberAt(ipc,ip,el)                                                                      ! phasememberAt should be tackled by material and be renamed to material_phasemember
+ associate(prm => param(instance), stt => state(instance))
- 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
+ Tstar_sph = math_spherical33(Tstar)
- squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph_33,Tstar_sph_33)
+ squarenorm_Tstar_sph = math_mul33xx33(Tstar_sph,Tstar_sph)
  norm_Tstar_sph = sqrt(squarenorm_Tstar_sph)
 
- if (prm%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                                          ! no stress or J2 plastitiy --> Li and its derivative are zero
-   gamma_dot = prm%gdot0 &
+   gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Tstar_sph /(prm%fTaylor*stt%flowstress(of))) **prm%n
-               * (sqrt(1.5_pReal) * norm_Tstar_sph / prm%fTaylor / state(instance)%flowstress(of) ) &
-               **prm%n
 
-   Li = Tstar_sph_33/norm_Tstar_sph * gamma_dot/prm%fTaylor
+   Li = Tstar_sph/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) = (prm%n-1.0_pReal) * &
+     dLi_dTstar(k,l,m,n) = (prm%n-1.0_pReal) * Tstar_sph(k,l)*Tstar_sph(m,n) / squarenorm_Tstar_sph
-                                      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(k,l,k,l) = dLi_dTstar(k,l,k,l) + 1.0_pReal
 
-   dLi_dTstar_3333 = gamma_dot / prm%fTaylor * &
+   dLi_dTstar = gamma_dot / prm%fTaylor * dLi_dTstar / norm_Tstar_sph
-                                      dLi_dTstar_3333 / norm_Tstar_sph
  else
-  Li = 0.0_pReal
+   Li = 0.0_pReal
-  dLi_dTstar_3333 = 0.0_pReal
+   dLi_dTstar = 0.0_pReal
  endif
+
+ end associate
+
  end subroutine plastic_isotropic_LiAndItsTangent
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates the rate of change of microstructure
 !--------------------------------------------------------------------------------------------------
-subroutine plastic_isotropic_dotState(Tstar_v,ipc,ip,el)
+subroutine plastic_isotropic_dotState(Mp,instance,of)
  use prec, only: &
    dEq0
  use math, only: &
-   math_mul6x6
+   math_mul33xx33, &
- use material, only: &
+   math_deviatoric33
-   phasememberAt, &
-   material_phase, &
-   phase_plasticityInstance
 
  implicit none
- real(pReal), dimension(6), intent(in):: &
+ real(pReal), dimension(3,3),  intent(in) :: &
-   Tstar_v                                                                                          !< 2nd Piola Kirchhoff stress tensor in Mandel notation
+   Mp                                                                                               !< Mandel stress
- integer(pInt),             intent(in) :: &
+ integer(pInt),                intent(in) :: &
-   ipc, &                                                                                           !< component-ID of integration point
+   instance, &
-   ip, &                                                                                            !< integration point
+   of
-   el                                                                                               !< element
+
- type(tParameters), pointer :: prm
- real(pReal), dimension(6) :: &
-   Tstar_dev_v                                                                                      !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation
  real(pReal) :: &
    gamma_dot, &                                                                                     !< strainrate
    hardening, &                                                                                     !< hardening coefficient
    saturation, &                                                                                    !< saturation flowstress
-   norm_Tstar_v                                                                                     !< euclidean norm of Tstar_dev
+   norm_Mp                                                                                          !< norm of the (deviatoric) Mandel stress
- integer(pInt) :: &
-   instance, &                                                                                      !< instance of my instance (unique number of my constitutive model)
-   of                                                                                               !< shortcut notation for offset position in state array
 
- of = phasememberAt(ipc,ip,el)                                                                      ! phasememberAt should be tackled by material and be renamed to material_phasemember
+ associate(prm => param(instance), stt => state(instance), dot => dotState(instance))
- instance = phase_plasticityInstance(material_phase(ipc,ip,el))
- prm => param(instance)
 
-!--------------------------------------------------------------------------------------------------
-! norm of (deviatoric) 2nd Piola-Kirchhoff stress
  if (prm%dilatation) then
-   norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v))
+   norm_Mp = sqrt(math_mul33xx33(Mp,Mp))
  else
-   Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal
+   norm_Mp = sqrt(math_mul33xx33(math_deviatoric33(Mp),math_deviatoric33(Mp)))
-   Tstar_dev_v(4:6) = Tstar_v(4:6)
+ endif
-   norm_Tstar_v = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v))
+
- end if
+ gamma_dot = prm%gdot0 * (sqrt(1.5_pReal) * norm_Mp /(prm%fTaylor*stt%flowstress(of))) **prm%n
-!--------------------------------------------------------------------------------------------------
-! strain rate 
- gamma_dot = prm%gdot0 * ( sqrt(1.5_pReal) * norm_Tstar_v & 
-            / &!-----------------------------------------------------------------------------------
-           (prm%fTaylor*state(instance)%flowstress(of) ))**prm%n
 
-!--------------------------------------------------------------------------------------------------
-! hardening coefficient
  if (abs(gamma_dot) > 1e-12_pReal) then
    if (dEq0(prm%tausat_SinhFitA)) then
      saturation = prm%tausat
    else
      saturation = prm%tausat &
-                + asinh( (gamma_dot / prm%tausat_SinhFitA&
+                + asinh( (gamma_dot / prm%tausat_SinhFitA)**(1.0_pReal / prm%tausat_SinhFitD) &
-                         )**(1.0_pReal / prm%tausat_SinhFitD)&
                        )**(1.0_pReal / prm%tausat_SinhFitC) &
-                   / ( prm%tausat_SinhFitB &
+                   / prm%tausat_SinhFitB * (gamma_dot / prm%gdot0)**(1.0_pReal / prm%n)
-                       * (gamma_dot / prm%gdot0)**(1.0_pReal / prm%n) &
-                     )
    endif
    hardening = ( prm%h0 + prm%h0_slopeLnRate * log(gamma_dot) ) &
-               * abs( 1.0_pReal - state(instance)%flowstress(of)/saturation )**prm%a &
+               * abs( 1.0_pReal - stt%flowstress(of)/saturation )**prm%a &
-               * sign(1.0_pReal, 1.0_pReal - state(instance)%flowstress(of)/saturation)
+               * sign(1.0_pReal, 1.0_pReal - stt%flowstress(of)/saturation)
  else
    hardening = 0.0_pReal
  endif
 
- dotState(instance)%flowstress      (of) = hardening * gamma_dot
+ dot%flowstress      (of) = hardening * gamma_dot
- dotState(instance)%accumulatedShear(of) =             gamma_dot
+ dot%accumulatedShear(of) =             gamma_dot
+
+ end associate
 
 end subroutine plastic_isotropic_dotState
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief return array of constitutive results
 !--------------------------------------------------------------------------------------------------
-function plastic_isotropic_postResults(Tstar_v,ipc,ip,el)
+function plastic_isotropic_postResults(Mp,instance,of) result(postResults)
  use math, only: &
-   math_mul6x6
+   math_mul33xx33, &
- use material, only: &
+   math_deviatoric33
-   plasticState, &
-   material_phase, &
-   phasememberAt, &
-   phase_plasticityInstance
 
  implicit none
- real(pReal), dimension(6),  intent(in) :: &
+ real(pReal), dimension(3,3),  intent(in) :: &
-   Tstar_v                                                                                          !< 2nd Piola Kirchhoff stress tensor in Mandel notation
+   Mp                                                                                               !< Mandel stress
- integer(pInt),              intent(in) :: &
+ integer(pInt),                intent(in) :: &
-   ipc, &                                                                                           !< component-ID of integration point
+   instance, &
-   ip, &                                                                                            !< integration point
+   of
-   el                                                                                               !< element
 
- type(tParameters), pointer :: prm
+ real(pReal), dimension(sum(plastic_isotropic_sizePostResult(:,instance))) :: &
+   postResults
 
- real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: &
-                                           plastic_isotropic_postResults
-
- real(pReal), dimension(6) :: &
-   Tstar_dev_v                                                                                      !< deviatoric 2nd Piola Kirchhoff stress tensor in Mandel notation
  real(pReal) :: &
-   norm_Tstar_v                                                                                     ! euclidean norm of Tstar_dev
+   norm_Mp                                                                                          !< norm of the Mandel stress
  integer(pInt) :: &
-   instance, &                                                                                      !< instance of my instance (unique number of my constitutive model)
+   o,c
-   of, &                                                                                            !< shortcut notation for offset position in state array
-   c, &
-   o
 
- of = phasememberAt(ipc,ip,el)                                                                      ! phasememberAt should be tackled by material and be renamed to material_phasemember
+ associate(prm => param(instance), stt => state(instance))
- instance = phase_plasticityInstance(material_phase(ipc,ip,el))
- prm => param(instance)
 
-!--------------------------------------------------------------------------------------------------
-! norm of (deviatoric) 2nd Piola-Kirchhoff stress
  if (prm%dilatation) then
-   norm_Tstar_v = sqrt(math_mul6x6(Tstar_v,Tstar_v))
+   norm_Mp = sqrt(math_mul33xx33(Mp,Mp))
  else
-   Tstar_dev_v(1:3) = Tstar_v(1:3) - sum(Tstar_v(1:3))/3.0_pReal
+   norm_Mp = sqrt(math_mul33xx33(math_deviatoric33(Mp),math_deviatoric33(Mp)))
-   Tstar_dev_v(4:6) = Tstar_v(4:6)
+ endif
-   norm_Tstar_v = sqrt(math_mul6x6(Tstar_dev_v,Tstar_dev_v))
- end if
 
  c = 0_pInt
- plastic_isotropic_postResults = 0.0_pReal
 
- outputsLoop: do o = 1_pInt,plastic_isotropic_Noutput(instance)
+ outputsLoop: do o = 1_pInt,size(prm%outputID)
    select case(prm%outputID(o))
+
      case (flowstress_ID)
-       plastic_isotropic_postResults(c+1_pInt) = state(instance)%flowstress(of)
+       postResults(c+1_pInt) = stt%flowstress(of)
        c = c + 1_pInt
      case (strainrate_ID)
-       plastic_isotropic_postResults(c+1_pInt) = &
+       postResults(c+1_pInt) = prm%gdot0 &
-                prm%gdot0 * (            sqrt(1.5_pReal) * norm_Tstar_v & 
+                             * (sqrt(1.5_pReal) * norm_Mp /(prm%fTaylor * stt%flowstress(of)))**prm%n
-             / &!----------------------------------------------------------------------------------
-              (prm%fTaylor * state(instance)%flowstress(of)) ) ** prm%n
        c = c + 1_pInt
+
    end select
  enddo outputsLoop
 
+ end associate
+
 end function plastic_isotropic_postResults
 
 

src/plastic_none.f90

@@ -1,7 +1,8 @@
 !--------------------------------------------------------------------------------------------------
 !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
 !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for purely elastic material
+!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
+!> @brief Dummy plasticity for purely elastic material
 !--------------------------------------------------------------------------------------------------
 module plastic_none
 
@@ -13,7 +14,6 @@ module plastic_none
 
 contains
 
-
 !--------------------------------------------------------------------------------------------------
 !> @brief module initialization
 !> @details reads in material parameters, allocates arrays, and does sanity checks
@@ -32,52 +32,39 @@ subroutine plastic_none_init
    debug_levelBasic
  use IO, only: &
    IO_timeStamp
- use numerics, only: &
-   numerics_integrator
  use material, only: &
    phase_plasticity, &
+   material_allocatePlasticState, &
    PLASTICITY_NONE_label, &
+   PLASTICITY_NONE_ID, &
    material_phase, &
-   plasticState, &
+   plasticState
-   PLASTICITY_none_ID
 
  implicit none
-
  integer(pInt) :: &
-   maxNinstance, &
+   Ninstance, &
-   phase, &
+   p, &
-   NofMyPhase
+   NipcMyPhase
 
- write(6,'(/,a)')   ' <<<+-  constitutive_'//PLASTICITY_NONE_label//' init  -+>>>'
+ write(6,'(/,a)')   ' <<<+-  plastic_'//PLASTICITY_NONE_label//' init  -+>>>'
  write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
 #include "compilation_info.f90"
 
- maxNinstance = int(count(phase_plasticity == PLASTICITY_none_ID),pInt)
+ Ninstance = int(count(phase_plasticity == PLASTICITY_NONE_ID),pInt)
  if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
-   write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
+   write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
 
- initializeInstances: do phase = 1_pInt, size(phase_plasticity)
+ do p = 1_pInt, size(phase_plasticity)
-   if (phase_plasticity(phase) == PLASTICITY_none_ID) then
+   if (phase_plasticity(p) /= PLASTICITY_NONE_ID) cycle
-   NofMyPhase=count(material_phase==phase)
 
-     allocate(plasticState(phase)%aTolState          (0_pInt))
+!--------------------------------------------------------------------------------------------------
-     allocate(plasticState(phase)%state0             (0_pInt,NofMyPhase))
+! allocate state arrays
-     allocate(plasticState(phase)%partionedState0    (0_pInt,NofMyPhase))
+   NipcMyPhase = count(material_phase == p)
-     allocate(plasticState(phase)%subState0          (0_pInt,NofMyPhase))
+   call material_allocatePlasticState(p,NipcMyPhase,0_pInt,0_pInt,0_pInt, &
-     allocate(plasticState(phase)%state              (0_pInt,NofMyPhase))
+                                      0_pInt,0_pInt,0_pInt)
+   plasticState(p)%sizePostResults = 0_pInt
 
-     allocate(plasticState(phase)%dotState           (0_pInt,NofMyPhase))
+ enddo
-     allocate(plasticState(phase)%deltaState         (0_pInt,NofMyPhase))
-     if (any(numerics_integrator == 1_pInt)) then
-       allocate(plasticState(phase)%previousDotState (0_pInt,NofMyPhase))
-       allocate(plasticState(phase)%previousDotState2(0_pInt,NofMyPhase))
-     endif
-     if (any(numerics_integrator == 4_pInt)) &
-       allocate(plasticState(phase)%RK4dotState      (0_pInt,NofMyPhase))
-     if (any(numerics_integrator == 5_pInt)) &
-       allocate(plasticState(phase)%RKCK45dotState (6,0_pInt,NofMyPhase))
-   endif
- enddo initializeInstances
 
 end subroutine plastic_none_init
 

src/plastic_nonlocal.f90

@@ -150,61 +150,34 @@ module plastic_nonlocal
  
  enum, bind(c) 
    enumerator :: undefined_ID, &
-                 rho_ID, &
-                 delta_ID, &
-                 rho_edge_ID, &
-                 rho_screw_ID, &
-                 rho_sgl_ID, &
-                 delta_sgl_ID, &
-                 rho_sgl_edge_ID, &
-                 rho_sgl_edge_pos_ID, &
-                 rho_sgl_edge_neg_ID, &
-                 rho_sgl_screw_ID, &
-                 rho_sgl_screw_pos_ID, &
-                 rho_sgl_screw_neg_ID, &
-                 rho_sgl_mobile_ID, &
-                 rho_sgl_edge_mobile_ID, &
                  rho_sgl_edge_pos_mobile_ID, &
                  rho_sgl_edge_neg_mobile_ID, &
-                 rho_sgl_screw_mobile_ID, &
                  rho_sgl_screw_pos_mobile_ID, &
                  rho_sgl_screw_neg_mobile_ID, &
-                 rho_sgl_immobile_ID, &
-                 rho_sgl_edge_immobile_ID, &
                  rho_sgl_edge_pos_immobile_ID, &
                  rho_sgl_edge_neg_immobile_ID, &
-                 rho_sgl_screw_immobile_ID, &
                  rho_sgl_screw_pos_immobile_ID, &
                  rho_sgl_screw_neg_immobile_ID, &
-                 rho_dip_ID, &
-                 delta_dip_ID, &
                  rho_dip_edge_ID, &
                  rho_dip_screw_ID, &
-                 excess_rho_ID, &
-                 excess_rho_edge_ID, &
-                 excess_rho_screw_ID, &
                  rho_forest_ID, &
                  shearrate_ID, &
                  resolvedstress_ID, &
                  resolvedstress_external_ID, &
                  resolvedstress_back_ID, &
                  resistance_ID, &
-                 rho_dot_ID, &
                  rho_dot_sgl_ID, &
                  rho_dot_sgl_mobile_ID, &
                  rho_dot_dip_ID, &
                  rho_dot_gen_ID, &
                  rho_dot_gen_edge_ID, &
                  rho_dot_gen_screw_ID, &
-                 rho_dot_sgl2dip_ID, &
                  rho_dot_sgl2dip_edge_ID, &
                  rho_dot_sgl2dip_screw_ID, &
                  rho_dot_ann_ath_ID, &
-                 rho_dot_ann_the_ID, &
                  rho_dot_ann_the_edge_ID, &
                  rho_dot_ann_the_screw_ID, &
                  rho_dot_edgejogs_ID, &
-                 rho_dot_flux_ID, &
                  rho_dot_flux_mobile_ID, &
                  rho_dot_flux_edge_ID, &
                  rho_dot_flux_screw_ID, &
@@ -212,28 +185,9 @@ module plastic_nonlocal
                  velocity_edge_neg_ID, &
                  velocity_screw_pos_ID, &
                  velocity_screw_neg_ID, &
-                 slipdirectionx_ID, &
-                 slipdirectiony_ID, &
-                 slipdirectionz_ID, &
-                 slipnormalx_ID, &
-                 slipnormaly_ID, &
-                 slipnormalz_ID, &
-                 fluxdensity_edge_posx_ID, &
-                 fluxdensity_edge_posy_ID, &
-                 fluxdensity_edge_posz_ID, &
-                 fluxdensity_edge_negx_ID, &
-                 fluxdensity_edge_negy_ID, &
-                 fluxdensity_edge_negz_ID, &
-                 fluxdensity_screw_posx_ID, &
-                 fluxdensity_screw_posy_ID, &
-                 fluxdensity_screw_posz_ID, &
-                 fluxdensity_screw_negx_ID, &
-                 fluxdensity_screw_negy_ID, &
-                 fluxdensity_screw_negz_ID, &
                  maximumdipoleheight_edge_ID, &
                  maximumdipoleheight_screw_ID, &
-                 accumulatedshear_ID, &
+                 accumulatedshear_ID
-                 dislocationstress_ID
  end enum
  integer(kind(undefined_ID)), dimension(:,:),   allocatable, private :: & 
    plastic_nonlocal_outputID                                                              !< ID of each post result output
@@ -262,8 +216,7 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_nonlocal_init(fileUnit)
 use, intrinsic :: iso_fortran_env                                          ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
-use math,     only: math_Mandel3333to66, & 
+use math,     only: math_Voigt66to3333, & 
-                    math_Voigt66to3333, & 
                     math_mul3x3, &
                     math_transpose33
 use IO,       only: IO_read, &
@@ -291,11 +244,11 @@ use material, only: phase_plasticity, &
                     PLASTICITY_NONLOCAL_label, &
                     PLASTICITY_NONLOCAL_ID, &
                     plasticState, &
-                    material_phase
+                    material_phase, &
+                    material_allocatePlasticState
 use config, only:  MATERIAL_partPhase
 use lattice
-use numerics,only: &
+
-   numerics_integrator
 
 
 implicit none
@@ -426,76 +379,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
      select case(tag)
        case ('(output)')
          select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
-           case ('rho')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('delta')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_edge')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_edge_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_screw')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_screw_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('delta_sgl')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_sgl_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_edge')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_edge_pos')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_edge_neg')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_screw')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_screw_pos')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_screw_neg')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_mobile')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_mobile_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_edge_mobile')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_mobile_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_sgl_edge_pos_mobile')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_mobile_ID
@@ -506,11 +389,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_mobile_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_screw_mobile')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_mobile_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_sgl_screw_pos_mobile')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_mobile_ID
@@ -521,16 +399,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_mobile_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_immobile')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_immobile_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_edge_immobile')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_immobile_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_sgl_edge_pos_immobile')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_pos_immobile_ID
@@ -541,11 +409,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_edge_neg_immobile_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_sgl_screw_immobile')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_immobile_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_sgl_screw_pos_immobile')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_pos_immobile_ID
@@ -556,16 +419,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_sgl_screw_neg_immobile_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_dip')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('delta_dip')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = delta_dip_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_dip_edge')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_edge_ID
@@ -576,21 +429,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dip_screw_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('excess_rho')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('excess_rho_edge')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_edge_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('excess_rho_screw')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = excess_rho_screw_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_forest')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_forest_ID
@@ -621,11 +459,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = resistance_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_dot')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_dot_sgl')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl_ID
@@ -656,11 +489,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_gen_screw_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_dot_sgl2dip')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_dot_sgl2dip_edge')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_sgl2dip_edge_ID
@@ -676,11 +504,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_ath_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_dot_ann_the')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_dot_ann_the_edge')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_ann_the_edge_ID
@@ -696,11 +519,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_edgejogs_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('rho_dot_flux')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('rho_dot_flux_mobile')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = rho_dot_flux_mobile_ID
@@ -736,96 +554,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = velocity_screw_neg_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('slipdirection.x')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionx_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('slipdirection.y')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectiony_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('slipdirection.z')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipdirectionz_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('slipnormal.x')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalx_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('slipnormal.y')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormaly_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('slipnormal.z')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = slipnormalz_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_edge_pos.x')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posx_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_edge_pos.y')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posy_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_edge_pos.z')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_posz_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_edge_neg.x')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negx_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_edge_neg.y')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negy_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_edge_neg.z')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_edge_negz_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_screw_pos.x')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posx_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_screw_pos.y')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posy_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_screw_pos.z')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_posz_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_screw_neg.x')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negx_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_screw_neg.y')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negy_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('fluxdensity_screw_neg.z')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = fluxdensity_screw_negz_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
            case ('maximumdipoleheight_edge')
              plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = maximumdipoleheight_edge_ID
@@ -841,11 +569,6 @@ allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances),                  s
              plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = accumulatedshear_ID
              plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
                IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-           case ('dislocationstress')
-             plastic_nonlocal_Noutput(instance) = plastic_nonlocal_Noutput(instance) + 1_pInt
-             plastic_nonlocal_outputID(plastic_nonlocal_Noutput(instance),instance) = dislocationstress_ID
-             plastic_nonlocal_output(plastic_nonlocal_Noutput(instance),instance) = &
-               IO_lc(IO_stringValue(line,chunkPos,2_pInt))
          end select
        case ('nslip')
          if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) &
@@ -1195,93 +918,8 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances),
      
      outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
        select case(plastic_nonlocal_outputID(o,instance))
-         case( rho_ID, &
-               delta_ID, &
-               rho_edge_ID, &
-               rho_screw_ID, &
-               rho_sgl_ID, &
-               delta_sgl_ID, &
-               rho_sgl_edge_ID, &
-               rho_sgl_edge_pos_ID, &
-               rho_sgl_edge_neg_ID, &
-               rho_sgl_screw_ID, &
-               rho_sgl_screw_pos_ID, &
-               rho_sgl_screw_neg_ID, &
-               rho_sgl_mobile_ID, &
-               rho_sgl_edge_mobile_ID, &
-               rho_sgl_edge_pos_mobile_ID, &
-               rho_sgl_edge_neg_mobile_ID, &
-               rho_sgl_screw_mobile_ID, &
-               rho_sgl_screw_pos_mobile_ID, &
-               rho_sgl_screw_neg_mobile_ID, &
-               rho_sgl_immobile_ID, &
-               rho_sgl_edge_immobile_ID, &
-               rho_sgl_edge_pos_immobile_ID, &
-               rho_sgl_edge_neg_immobile_ID, &
-               rho_sgl_screw_immobile_ID, &
-               rho_sgl_screw_pos_immobile_ID, &
-               rho_sgl_screw_neg_immobile_ID, &
-               rho_dip_ID, &
-               delta_dip_ID, &
-               rho_dip_edge_ID, &
-               rho_dip_screw_ID, &
-               excess_rho_ID, &
-               excess_rho_edge_ID, &
-               excess_rho_screw_ID, &
-               rho_forest_ID, &
-               shearrate_ID, &
-               resolvedstress_ID, &
-               resolvedstress_external_ID, &
-               resolvedstress_back_ID, &
-               resistance_ID, &
-               rho_dot_ID, &
-               rho_dot_sgl_ID, &
-               rho_dot_sgl_mobile_ID, &
-               rho_dot_dip_ID, &
-               rho_dot_gen_ID, &
-               rho_dot_gen_edge_ID, &
-               rho_dot_gen_screw_ID, &
-               rho_dot_sgl2dip_ID, &
-               rho_dot_sgl2dip_edge_ID, &
-               rho_dot_sgl2dip_screw_ID, &
-               rho_dot_ann_ath_ID, &
-               rho_dot_ann_the_ID, &
-               rho_dot_ann_the_edge_ID, &
-               rho_dot_ann_the_screw_ID, &
-               rho_dot_edgejogs_ID, &
-               rho_dot_flux_ID, &
-               rho_dot_flux_mobile_ID, &
-               rho_dot_flux_edge_ID, &
-               rho_dot_flux_screw_ID, &
-               velocity_edge_pos_ID, &
-               velocity_edge_neg_ID, &
-               velocity_screw_pos_ID, &
-               velocity_screw_neg_ID, &
-               slipdirectionx_ID, &
-               slipdirectiony_ID, &
-               slipdirectionz_ID, &
-               slipnormalx_ID, &
-               slipnormaly_ID, &
-               slipnormalz_ID, &
-               fluxdensity_edge_posx_ID, &
-               fluxdensity_edge_posy_ID, &
-               fluxdensity_edge_posz_ID, &
-               fluxdensity_edge_negx_ID, &
-               fluxdensity_edge_negy_ID, &
-               fluxdensity_edge_negz_ID, &
-               fluxdensity_screw_posx_ID, &
-               fluxdensity_screw_posy_ID, &
-               fluxdensity_screw_posz_ID, &
-               fluxdensity_screw_negx_ID, &
-               fluxdensity_screw_negy_ID, &
-               fluxdensity_screw_negz_ID, &
-               maximumdipoleheight_edge_ID, &
-               maximumdipoleheight_screw_ID, &
-               accumulatedshear_ID )
-           mySize = totalNslip(instance)
-         case(dislocationstress_ID)
-           mySize = 6_pInt
          case default
+           mySize = totalNslip(instance)
        end select
    
        if (mySize > 0_pInt) then                                                                       ! any meaningful output found                               
@@ -1290,30 +928,14 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances),
        endif
      enddo outputsLoop
                 
-     plasticState(phase)%sizeState    = sizeState
+
-     plasticState(phase)%sizeDotState = sizeDotState
-     plasticState(phase)%sizeDeltaState = sizeDeltaState
      plasticState(phase)%sizePostResults = plastic_nonlocal_sizePostResults(instance)
      plasticState(phase)%nonlocal = .true.
-     plasticState(phase)%nSlip = totalNslip(instance)
+     call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, &
-     plasticState(phase)%nTwin = 0_pInt
+                                        totalNslip(instance),0_pInt,0_pInt)
-     plasticState(phase)%nTrans= 0_pInt
+    
-     allocate(plasticState(phase)%aTolState           (sizeState),                source=0.0_pReal)
+     plasticState(phase)%offsetDeltaState = 0_pInt
-     allocate(plasticState(phase)%state0              (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(plasticState(phase)%partionedState0     (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(plasticState(phase)%subState0           (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(plasticState(phase)%state               (sizeState,NofMyPhase),     source=0.0_pReal)
        
-     allocate(plasticState(phase)%dotState            (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     allocate(plasticState(phase)%deltaState        (sizeDeltaState,NofMyPhase),  source=0.0_pReal)
-     if (any(numerics_integrator == 1_pInt)) then
-       allocate(plasticState(phase)%previousDotState  (sizeDotState,NofMyPhase),  source=0.0_pReal)
-       allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     endif
-     if (any(numerics_integrator == 4_pInt)) &
-       allocate(plasticState(phase)%RK4dotState       (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     if (any(numerics_integrator == 5_pInt)) &
-       allocate(plasticState(phase)%RKCK45dotState    (6,sizeDotState,NofMyPhase),source=0.0_pReal)
      plasticState(phase)%slipRate => &
        plasticState(phase)%dotState(iGamma(1,instance):iGamma(ns,instance),1:NofMyPhase)
      plasticState(phase)%accumulatedSlip => &
@@ -1999,10 +1621,10 @@ end subroutine plastic_nonlocal_kinetics
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_nonlocal_LpAndItsTangent(Lp, dLp_dTstar99, Tstar_v, Temperature, ip, el)
 
-use math,     only: math_Plain3333to99, &
+use math,     only: math_3333to99, &
                     math_mul6x6, &
                     math_mul33xx33, &
-                    math_Mandel6to33
+                    math_6toSym33
 use debug,    only: debug_level, &
                     debug_constitutive, &
                     debug_levelExtensive, &
@@ -2094,11 +1716,11 @@ do s = 1_pInt,ns
   tauNS(s,1) = tau(s)
   tauNS(s,2) = tau(s)
   if (tau(s) > 0.0_pReal) then
-    tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance))
+    tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,1,s,instance))
-    tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance))
+    tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,3,s,instance))
   else
-    tauNS(s,3) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance))
+    tauNS(s,3) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,2,s,instance))
-    tauNS(s,4) = math_mul33xx33(math_Mandel6to33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance))
+    tauNS(s,4) = math_mul33xx33(math_6toSym33(Tstar_v), nonSchmidProjection(1:3,1:3,4,s,instance))
   endif
 enddo
 forall (t = 1_pInt:4_pInt) &
@@ -2173,7 +1795,7 @@ do s = 1_pInt,ns
           * burgers(s,instance)
   endif
 enddo
-dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333)
+dLp_dTstar99 = math_3333to99(dLp_dTstar3333)
 
 
 #ifdef DEBUG
@@ -3655,45 +3277,6 @@ forall (s = 1_pInt:ns) &
 
 outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
   select case(plastic_nonlocal_outputID(o,instance))
-    case (rho_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2) + sum(rhoDip,2)
-      cs = cs + ns
-      
-    case (rho_sgl_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl),2)
-      cs = cs + ns
-      
-    case (rho_sgl_mobile_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,1:4)),2)
-      cs = cs + ns
-      
-    case (rho_sgl_immobile_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:8),2)
-      cs = cs + ns
-      
-    case (rho_dip_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDip,2)
-      cs = cs + ns
-      
-    case (rho_edge_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2) + rhoDip(1:ns,1)
-      cs = cs + ns
-      
-    case (rho_sgl_edge_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[1,2,5,6])),2)
-      cs = cs + ns
-      
-    case (rho_sgl_edge_mobile_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,1:2),2)
-      cs = cs + ns
-      
-    case (rho_sgl_edge_immobile_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,5:6),2)
-      cs = cs + ns
-      
-    case (rho_sgl_edge_pos_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))
-      cs = cs + ns
       
     case (rho_sgl_edge_pos_mobile_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1)
@@ -3703,10 +3286,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,5)
       cs = cs + ns
       
-    case (rho_sgl_edge_neg_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))
-      cs = cs + ns
-      
     case (rho_sgl_edge_neg_mobile_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,2)
       cs = cs + ns
@@ -3719,26 +3298,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,1)
       cs = cs + ns
       
-    case (rho_screw_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2) + rhoDip(1:ns,2)
-      cs = cs + ns
-      
-    case (rho_sgl_screw_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(abs(rhoSgl(1:ns,[3,4,7,8])),2)
-      cs = cs + ns
-            
-    case (rho_sgl_screw_mobile_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,3:4),2)
-      cs = cs + ns
-      
-    case (rho_sgl_screw_immobile_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoSgl(1:ns,7:8),2)
-      cs = cs + ns
-      
-    case (rho_sgl_screw_pos_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))
-      cs = cs + ns
-      
     case (rho_sgl_screw_pos_mobile_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3)
       cs = cs + ns
@@ -3747,10 +3306,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,7)
       cs = cs + ns
 
-    case (rho_sgl_screw_neg_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8))
-      cs = cs + ns
-
     case (rho_sgl_screw_neg_mobile_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,4)
       cs = cs + ns
@@ -3763,39 +3318,10 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDip(1:ns,2)
       cs = cs + ns
       
-    case (excess_rho_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) &
-                                                         - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6))) &
-                                                         + (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) &
-                                                         - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8)))
-      cs = cs + ns
-      
-    case (excess_rho_edge_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,1) + abs(rhoSgl(1:ns,5))) &
-                                                         - (rhoSgl(1:ns,2) + abs(rhoSgl(1:ns,6)))
-      cs = cs + ns
-      
-    case (excess_rho_screw_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = (rhoSgl(1:ns,3) + abs(rhoSgl(1:ns,7))) &
-                                                         - (rhoSgl(1:ns,4) + abs(rhoSgl(1:ns,8)))
-      cs = cs + ns
-      
     case (rho_forest_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoForest
       cs = cs + ns
       
-    case (delta_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2) + sum(rhoDip,2))
-      cs = cs + ns
-      
-    case (delta_sgl_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(abs(rhoSgl),2))
-      cs = cs + ns
-      
-    case (delta_dip_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = 1.0_pReal / sqrt(sum(rhoDip,2))
-      cs = cs + ns
-      
     case (shearrate_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(gdot,2)
       cs = cs + ns
@@ -3819,12 +3345,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = tauThreshold
       cs = cs + ns
       
-    case (rho_dot_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) &
-                                                         + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2) &
-                                                         + sum(rhoDotDip,2)
-      cs = cs + ns
-      
     case (rho_dot_sgl_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotSgl(1:ns,1:4),2) &
                                                          + sum(rhoDotSgl(1:ns,5:8)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2)
@@ -3838,7 +3358,7 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotDip,2)
       cs = cs + ns
     
-    case (rho_dot_gen_ID)
+    case (rho_dot_gen_ID)  ! Obsolete
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,1,1_pInt,ip,el) &
                                                          + rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el)
       cs = cs + ns
@@ -3851,11 +3371,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotMultiplicationOutput(1:ns,2,1_pInt,ip,el)
       cs = cs + ns
     
-    case (rho_dot_sgl2dip_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el) &
-                                                         + rhoDotSingle2DipoleGlideOutput(1:ns,2,1_pInt,ip,el)
-      cs = cs + ns
-    
     case (rho_dot_sgl2dip_edge_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotSingle2DipoleGlideOutput(1:ns,1,1_pInt,ip,el)
       cs = cs + ns
@@ -3869,11 +3384,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
                                                          + rhoDotAthermalAnnihilationOutput(1:ns,2,1_pInt,ip,el)
       cs = cs + ns
 
-    case (rho_dot_ann_the_ID) 
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) & 
-                                                         + rhoDotThermalAnnihilationOutput(1:ns,2,1_pInt,ip,el)
-      cs = cs + ns
-
     case (rho_dot_ann_the_edge_ID) 
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoDotThermalAnnihilationOutput(1:ns,1,1_pInt,ip,el) 
       cs = cs + ns
@@ -3890,11 +3400,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2)
       cs = cs + ns
     
-    case (rho_dot_flux_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:4,1_pInt,ip,el),2) &
-                          + sum(rhoDotFluxOutput(1:ns,5:8,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:8)),2)
-      cs = cs + ns
-    
     case (rho_dot_flux_edge_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = sum(rhoDotFluxOutput(1:ns,1:2,1_pInt,ip,el),2) &
                           + sum(rhoDotFluxOutput(1:ns,5:6,1_pInt,ip,el)*sign(1.0_pReal,rhoSgl(1:ns,5:6)),2)
@@ -3921,78 +3426,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = v(1:ns,4)
       cs = cs + ns
     
-    case (slipdirectionx_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(1,1:ns,1)
-      cs = cs + ns
-    
-    case (slipdirectiony_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(2,1:ns,1)
-      cs = cs + ns
-    
-    case (slipdirectionz_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = m_currentconf(3,1:ns,1)
-      cs = cs + ns
-    
-    case (slipnormalx_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(1,1:ns)
-      cs = cs + ns
-    
-    case (slipnormaly_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(2,1:ns)
-      cs = cs + ns
-    
-    case (slipnormalz_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = n_currentconf(3,1:ns)
-      cs = cs + ns
-    
-    case (fluxdensity_edge_posx_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(1,1:ns,1)
-      cs = cs + ns
-    
-    case (fluxdensity_edge_posy_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(2,1:ns,1)
-      cs = cs + ns
-    
-    case (fluxdensity_edge_posz_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1) * v(1:ns,1) * m_currentconf(3,1:ns,1)
-      cs = cs + ns
-    
-    case (fluxdensity_edge_negx_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(1,1:ns,1)
-      cs = cs + ns
-    
-    case (fluxdensity_edge_negy_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(2,1:ns,1)
-      cs = cs + ns
-    
-    case (fluxdensity_edge_negz_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,2) * v(1:ns,2) * m_currentconf(3,1:ns,1)
-      cs = cs + ns
-    
-    case (fluxdensity_screw_posx_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(1,1:ns,2)
-      cs = cs + ns
-    
-    case (fluxdensity_screw_posy_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(2,1:ns,2)
-      cs = cs + ns
-    
-    case (fluxdensity_screw_posz_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,3) * v(1:ns,3) * m_currentconf(3,1:ns,2)
-      cs = cs + ns
-    
-    case (fluxdensity_screw_negx_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(1,1:ns,2)
-      cs = cs + ns
-    
-    case (fluxdensity_screw_negy_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(2,1:ns,2)
-      cs = cs + ns
-    
-    case (fluxdensity_screw_negz_ID)
-      plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = - rhoSgl(1:ns,4) * v(1:ns,4) * m_currentconf(3,1:ns,2)
-      cs = cs + ns
-    
     case (maximumdipoleheight_edge_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,1)
       cs = cs + ns
@@ -4001,16 +3434,6 @@ outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = dUpper(1:ns,2)
       cs = cs + ns
 
-    case(dislocationstress_ID)
-      sigma = plastic_nonlocal_dislocationstress(Fe, ip, el)
-      plastic_nonlocal_postResults(cs+1_pInt) = sigma(1,1)
-      plastic_nonlocal_postResults(cs+2_pInt) = sigma(2,2)
-      plastic_nonlocal_postResults(cs+3_pInt) = sigma(3,3)
-      plastic_nonlocal_postResults(cs+4_pInt) = sigma(1,2)
-      plastic_nonlocal_postResults(cs+5_pInt) = sigma(2,3)
-      plastic_nonlocal_postResults(cs+6_pInt) = sigma(3,1)
-      cs = cs + 6_pInt
-    
     case(accumulatedshear_ID)
       plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = plasticState(ph)%state(iGamma(1:ns,instance),of)
       cs = cs + ns

src/plastic_phenopowerlaw.f90

@@ -2,12 +2,11 @@
 !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
 !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
 !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw
+!> @brief  phenomenological crystal plasticity formulation using a powerlaw fitting
-!! fitting
 !--------------------------------------------------------------------------------------------------
 module plastic_phenopowerlaw
  use prec, only: &
-   pReal,&
+   pReal, &
    pInt
 
  implicit none
@@ -73,19 +72,19 @@ module plastic_phenopowerlaw
      Ntwin                                                                                          !< number of active twin systems for each family
    integer(kind(undefined_ID)), allocatable, dimension(:) :: &
      outputID                                                                                       !< ID of each post result output
- end type                                                                                           !< container type for internal constitutive parameters
+ end type tParameters
-
- type(tParameters), dimension(:), allocatable, private :: param                                     !< containers of constitutive parameters (len Ninstance)
 
  type, private :: tPhenopowerlawState
    real(pReal), pointer, dimension(:,:) :: &
      xi_slip, &
      xi_twin, &
      gamma_slip, &
-     gamma_twin, &
+     gamma_twin
-     whole
+ end type tPhenopowerlawState
- end type
 
+!--------------------------------------------------------------------------------------------------
+! containers for parameters and state
+ type(tParameters),         allocatable, dimension(:), private :: param
  type(tPhenopowerlawState), allocatable, dimension(:), private :: &
    dotState, &
    state
@@ -94,7 +93,11 @@ module plastic_phenopowerlaw
    plastic_phenopowerlaw_init, &
    plastic_phenopowerlaw_LpAndItsTangent, &
    plastic_phenopowerlaw_dotState, &
-   plastic_phenopowerlaw_postResults
+   plastic_phenopowerlaw_postResults, &
+   plastic_phenopowerlaw_results
+ private :: &
+   kinetics_slip, &
+   kinetics_twin
 
 contains
 
@@ -110,8 +113,7 @@ subroutine plastic_phenopowerlaw_init
    compiler_options
 #endif
  use prec, only: &
-   pStringLen, &
+   pStringLen
-   dEq0
  use debug, only: &
    debug_level, &
    debug_constitutive,&
@@ -119,7 +121,6 @@ subroutine plastic_phenopowerlaw_init
  use math, only: &
    math_expand
  use IO, only: &
-   IO_warning, &
    IO_error, &
    IO_timeStamp
  use material, only: &
@@ -149,15 +150,14 @@ subroutine plastic_phenopowerlaw_init
  character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
 
  integer(kind(undefined_ID)) :: &
-   outputID                                                                                         !< ID of each post result output
+   outputID
 
  character(len=pStringLen) :: &
-   structure = '',&
    extmsg = ''
  character(len=65536), dimension(:), allocatable :: &
    outputs
 
- write(6,'(/,a)')   ' <<<+-  constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init  -+>>>'
+ write(6,'(/,a)')   ' <<<+-  plastic_'//PLASTICITY_PHENOPOWERLAW_label//' init  -+>>>'
  write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
 #include "compilation_info.f90"
 
@@ -173,59 +173,59 @@ subroutine plastic_phenopowerlaw_init
  allocate(state(Ninstance))
  allocate(dotState(Ninstance))
 
- do p = 1_pInt, size(phase_plasticityInstance)
+ do p = 1_pInt, size(phase_plasticity)
    if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle
    associate(prm => param(phase_plasticityInstance(p)), &
              dot => dotState(phase_plasticityInstance(p)), &
-             stt => state(phase_plasticityInstance(p)))
+             stt => state(phase_plasticityInstance(p)), &
-
+             config => config_phase(p))
-   structure          = config_phase(p)%getString('lattice_structure')
 
 !--------------------------------------------------------------------------------------------------
 !  optional parameters that need to be defined
-   prm%twinB          = config_phase(p)%getFloat('twin_b',defaultVal=1.0_pReal)
+   prm%twinB          = config%getFloat('twin_b',defaultVal=1.0_pReal)
-   prm%twinC          = config_phase(p)%getFloat('twin_c',defaultVal=0.0_pReal)
+   prm%twinC          = config%getFloat('twin_c',defaultVal=0.0_pReal)
-   prm%twinD          = config_phase(p)%getFloat('twin_d',defaultVal=0.0_pReal)
+   prm%twinD          = config%getFloat('twin_d',defaultVal=0.0_pReal)
-   prm%twinE          = config_phase(p)%getFloat('twin_e',defaultVal=0.0_pReal)
+   prm%twinE          = config%getFloat('twin_e',defaultVal=0.0_pReal)
 
-   prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal)
+   prm%aTolResistance = config%getFloat('atol_resistance',defaultVal=1.0_pReal)
-   prm%aTolShear      = config_phase(p)%getFloat('atol_shear',     defaultVal=1.0e-6_pReal)
+   prm%aTolShear      = config%getFloat('atol_shear',     defaultVal=1.0e-6_pReal)
-   prm%aTolTwinfrac   = config_phase(p)%getFloat('atol_twinfrac',  defaultVal=1.0e-6_pReal)
+   prm%aTolTwinfrac   = config%getFloat('atol_twinfrac',  defaultVal=1.0e-6_pReal)
 
    ! sanity checks
-   if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//'aTolresistance '
+   if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//' aTolresistance'
-   if (prm%aTolShear      <= 0.0_pReal) extmsg = trim(extmsg)//'aTolShear '
+   if (prm%aTolShear      <= 0.0_pReal) extmsg = trim(extmsg)//' aTolShear'
-   if (prm%aTolTwinfrac   <= 0.0_pReal) extmsg = trim(extmsg)//'atoltwinfrac '
+   if (prm%aTolTwinfrac   <= 0.0_pReal) extmsg = trim(extmsg)//' atoltwinfrac'
 
 !--------------------------------------------------------------------------------------------------
 ! slip related parameters
-   prm%Nslip      = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray)
+   prm%Nslip      = config%getInts('nslip',defaultVal=emptyIntArray)
    prm%totalNslip = sum(prm%Nslip)
    slipActive: if (prm%totalNslip > 0_pInt) then
-     prm%Schmid_slip          = lattice_SchmidMatrix_slip(prm%Nslip,structure(1:3),&
+     prm%Schmid_slip = lattice_SchmidMatrix_slip(prm%Nslip,config%getString('lattice_structure'),&
-                                                          config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal))
+                                                 config%getFloat('c/a',defaultVal=0.0_pReal))
-     if(structure=='bcc') then
+
-       prm%nonSchmidCoeff     = config_phase(p)%getFloats('nonschmid_coefficients',&
+     if(trim(config%getString('lattice_structure')) == 'bcc') then
-                                                          defaultVal = emptyRealArray)
+       prm%nonSchmidCoeff = config%getFloats('nonschmid_coefficients',&
-       prm%nonSchmid_pos      = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt)
+                                                 defaultVal = emptyRealArray)
-       prm%nonSchmid_neg      = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt)
+       prm%nonSchmid_pos  = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,+1_pInt)
+       prm%nonSchmid_neg  = lattice_nonSchmidMatrix(prm%Nslip,prm%nonSchmidCoeff,-1_pInt)
      else
-       prm%nonSchmid_pos      = prm%Schmid_slip
+       prm%nonSchmid_pos  = prm%Schmid_slip
-       prm%nonSchmid_neg      = prm%Schmid_slip
+       prm%nonSchmid_neg  = prm%Schmid_slip
      endif
      prm%interaction_SlipSlip = lattice_interaction_SlipSlip(prm%Nslip, &
-                                                             config_phase(p)%getFloats('interaction_slipslip'), &
+                                                             config%getFloats('interaction_slipslip'), &
-                                                             structure(1:3))
+                                                             config%getString('lattice_structure'))
 
-     prm%xi_slip_0            = config_phase(p)%getFloats('tau0_slip',   requiredShape=shape(prm%Nslip))
+     prm%xi_slip_0   = config%getFloats('tau0_slip',   requiredSize=size(prm%Nslip))
-     prm%xi_slip_sat          = config_phase(p)%getFloats('tausat_slip', requiredShape=shape(prm%Nslip))
+     prm%xi_slip_sat = config%getFloats('tausat_slip', requiredSize=size(prm%Nslip))
-     prm%H_int                = config_phase(p)%getFloats('h_int',       requiredShape=shape(prm%Nslip), &
+     prm%H_int       = config%getFloats('h_int',       requiredSize=size(prm%Nslip), &
-                                                                         defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))])
+                                        defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))])
 
-     prm%gdot0_slip           = config_phase(p)%getFloat('gdot0_slip')
+     prm%gdot0_slip  = config%getFloat('gdot0_slip')
-     prm%n_slip               = config_phase(p)%getFloat('n_slip')
+     prm%n_slip      = config%getFloat('n_slip')
-     prm%a_slip               = config_phase(p)%getFloat('a_slip')
+     prm%a_slip      = config%getFloat('a_slip')
-     prm%h0_SlipSlip          = config_phase(p)%getFloat('h0_slipslip')
+     prm%h0_SlipSlip = config%getFloat('h0_slipslip')
 
      ! expand: family => system
      prm%xi_slip_0   = math_expand(prm%xi_slip_0,  prm%Nslip)
@@ -233,11 +233,11 @@ subroutine plastic_phenopowerlaw_init
      prm%H_int       = math_expand(prm%H_int,      prm%Nslip)
 
      ! sanity checks
-     if (prm%gdot0_slip <= 0.0_pReal)           extmsg = trim(extmsg)//'gdot0_slip '
+     if (    prm%gdot0_slip  <= 0.0_pReal)      extmsg = trim(extmsg)//' gdot0_slip'
-     if (dEq0(prm%a_slip))                      extmsg = trim(extmsg)//'a_slip '                    ! ToDo: negative values ok?
+     if (    prm%a_slip      <= 0.0_pReal)      extmsg = trim(extmsg)//' a_slip'
-     if (dEq0(prm%n_slip))                      extmsg = trim(extmsg)//'n_slip '                    ! ToDo: negative values ok?
+     if (    prm%n_slip      <= 0.0_pReal)      extmsg = trim(extmsg)//' n_slip'
-     if (any(prm%xi_slip_0   <= 0.0_pReal))     extmsg = trim(extmsg)//'xi_slip_0 '
+     if (any(prm%xi_slip_0   <= 0.0_pReal))     extmsg = trim(extmsg)//' xi_slip_0'
-     if (any(prm%xi_slip_sat <  prm%xi_slip_0)) extmsg = trim(extmsg)//'xi_slip_sat '
+     if (any(prm%xi_slip_sat <= 0.0_pReal))     extmsg = trim(extmsg)//' xi_slip_sat'
    else slipActive
      allocate(prm%interaction_SlipSlip(0,0))
      allocate(prm%xi_slip_0(0))
@@ -245,30 +245,30 @@ subroutine plastic_phenopowerlaw_init
 
 !--------------------------------------------------------------------------------------------------
 ! twin related parameters
-   prm%Ntwin      = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray)
+   prm%Ntwin      = config%getInts('ntwin', defaultVal=emptyIntArray)
    prm%totalNtwin = sum(prm%Ntwin)
    twinActive: if (prm%totalNtwin > 0_pInt) then
-     prm%Schmid_twin          = lattice_SchmidMatrix_twin(prm%Ntwin,structure(1:3),&
+     prm%Schmid_twin          = lattice_SchmidMatrix_twin(prm%Ntwin,config%getString('lattice_structure'),&
-                                                          config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal))
+                                                          config%getFloat('c/a',defaultVal=0.0_pReal))
      prm%interaction_TwinTwin = lattice_interaction_TwinTwin(prm%Ntwin,&
-                                                             config_phase(p)%getFloats('interaction_twintwin'), &
+                                                             config%getFloats('interaction_twintwin'), &
-                                                             structure(1:3))
+                                                             config%getString('lattice_structure'))
-     prm%gamma_twin_char      = lattice_characteristicShear_twin(prm%Ntwin,structure(1:3),&
+     prm%gamma_twin_char      = lattice_characteristicShear_twin(prm%Ntwin,config%getString('lattice_structure'),&
-                                                            config_phase(p)%getFloat('c/a'))
+                                                            config%getFloat('c/a'))
 
-     prm%xi_twin_0            = config_phase(p)%getFloats('tau0_twin',requiredShape=shape(prm%Ntwin))
+     prm%xi_twin_0            = config%getFloats('tau0_twin',requiredSize=size(prm%Ntwin))
 
-     prm%gdot0_twin           = config_phase(p)%getFloat('gdot0_twin')
+     prm%gdot0_twin           = config%getFloat('gdot0_twin')
-     prm%n_twin               = config_phase(p)%getFloat('n_twin')
+     prm%n_twin               = config%getFloat('n_twin')
-     prm%spr                  = config_phase(p)%getFloat('s_pr')
+     prm%spr                  = config%getFloat('s_pr')
-     prm%h0_TwinTwin          = config_phase(p)%getFloat('h0_twintwin')
+     prm%h0_TwinTwin          = config%getFloat('h0_twintwin')
 
      ! expand: family => system
      prm%xi_twin_0   = math_expand(prm%xi_twin_0,  prm%Ntwin)
 
      ! sanity checks
-     if (prm%gdot0_twin <= 0.0_pReal)  extmsg = trim(extmsg)//'gdot0_twin '
+     if (prm%gdot0_twin <= 0.0_pReal)  extmsg = trim(extmsg)//' gdot0_twin'
-     if (dEq0(prm%n_twin))             extmsg = trim(extmsg)//'n_twin '                             ! ToDo: negative values ok?
+     if (prm%n_twin     <= 0.0_pReal)  extmsg = trim(extmsg)//' n_twin'
    else twinActive
      allocate(prm%interaction_TwinTwin(0,0))
      allocate(prm%xi_twin_0(0))
@@ -279,11 +279,11 @@ subroutine plastic_phenopowerlaw_init
 ! slip-twin related parameters
    slipAndTwinActive: if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then
      prm%interaction_SlipTwin = lattice_interaction_SlipTwin(prm%Nslip,prm%Ntwin,&
-                                                             config_phase(p)%getFloats('interaction_sliptwin'), &
+                                                             config%getFloats('interaction_sliptwin'), &
-                                                             structure(1:3))
+                                                             config%getString('lattice_structure'))
      prm%interaction_TwinSlip = lattice_interaction_TwinSlip(prm%Ntwin,prm%Nslip,&
-                                                             config_phase(p)%getFloats('interaction_twinslip'), &
+                                                             config%getFloats('interaction_twinslip'), &
-                                                             structure(1:3))
+                                                             config%getString('lattice_structure'))
    else slipAndTwinActive
      allocate(prm%interaction_SlipTwin(prm%totalNslip,prm%TotalNtwin))                              ! at least one dimension is 0
      allocate(prm%interaction_TwinSlip(prm%totalNtwin,prm%TotalNslip))                              ! at least one dimension is 0
@@ -297,59 +297,59 @@ subroutine plastic_phenopowerlaw_init
 
 !--------------------------------------------------------------------------------------------------
 !  output pararameters
-   outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray)
+   outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
    allocate(prm%outputID(0))
    do i=1_pInt, size(outputs)
      outputID = undefined_ID
      select case(outputs(i))
-        case ('resistance_slip')
-          outputID = merge(resistance_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
-          outputSize = prm%totalNslip
-        case ('accumulatedshear_slip')
-          outputID = merge(accumulatedshear_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
-          outputSize = prm%totalNslip
-        case ('shearrate_slip')
-          outputID = merge(shearrate_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
-          outputSize = prm%totalNslip
-        case ('resolvedstress_slip')
-          outputID = merge(resolvedstress_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
-          outputSize = prm%totalNslip
 
-        case ('resistance_twin')
+       case ('resistance_slip')
-          outputID = merge(resistance_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
+         outputID = merge(resistance_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
-          outputSize = prm%totalNtwin
+         outputSize = prm%totalNslip
-        case ('accumulatedshear_twin')
+       case ('accumulatedshear_slip')
-          outputID = merge(accumulatedshear_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
+         outputID = merge(accumulatedshear_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
-          outputSize = prm%totalNtwin
+         outputSize = prm%totalNslip
-        case ('shearrate_twin')
+       case ('shearrate_slip')
-          outputID = merge(shearrate_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
+         outputID = merge(shearrate_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
-          outputSize = prm%totalNtwin
+         outputSize = prm%totalNslip
-        case ('resolvedstress_twin')
+       case ('resolvedstress_slip')
-          outputID = merge(resolvedstress_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
+         outputID = merge(resolvedstress_slip_ID,undefined_ID,prm%totalNslip>0_pInt)
-          outputSize = prm%totalNtwin
+         outputSize = prm%totalNslip
 
-      end select
+       case ('resistance_twin')
+         outputID = merge(resistance_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
+         outputSize = prm%totalNtwin
+       case ('accumulatedshear_twin')
+         outputID = merge(accumulatedshear_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
+         outputSize = prm%totalNtwin
+       case ('shearrate_twin')
+         outputID = merge(shearrate_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
+         outputSize = prm%totalNtwin
+       case ('resolvedstress_twin')
+         outputID = merge(resolvedstress_twin_ID,undefined_ID,prm%totalNtwin>0_pInt)
+         outputSize = prm%totalNtwin
 
-      if (outputID /= undefined_ID) then
+     end select
-        plastic_phenopowerlaw_output(i,phase_plasticityInstance(p)) = outputs(i)
-        plastic_phenopowerlaw_sizePostResult(i,phase_plasticityInstance(p)) = outputSize
-        prm%outputID = [prm%outputID , outputID]
-      endif
 
-   end do
+     if (outputID /= undefined_ID) then
+       plastic_phenopowerlaw_output(i,phase_plasticityInstance(p)) = outputs(i)
+       plastic_phenopowerlaw_sizePostResult(i,phase_plasticityInstance(p)) = outputSize
+       prm%outputID = [prm%outputID, outputID]
+     endif
+
+   enddo
 
 !--------------------------------------------------------------------------------------------------
 ! allocate state arrays
-   NipcMyPhase = count(material_phase == p)                                                         ! number of IPCs containing my phase
+   NipcMyPhase = count(material_phase == p)
-   sizeState = size(['tau_slip  ','gamma_slip']) * prm%TotalNslip &
+   sizeDotState = size(['tau_slip  ','gamma_slip']) * prm%totalNslip &
-             + size(['tau_twin  ','gamma_twin']) * prm%TotalNtwin
+                + size(['tau_twin  ','gamma_twin']) * prm%totalNtwin
-   sizeDotState = sizeState
+   sizeState = sizeDotState
 
    call material_allocatePlasticState(p,NipcMyPhase,sizeState,sizeDotState,0_pInt, &
                                       prm%totalNslip,prm%totalNtwin,0_pInt)
    plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,phase_plasticityInstance(p)))
 
-
 !--------------------------------------------------------------------------------------------------
 ! locally defined state aliases and initialization of state0 and aTolState
    startIndex = 1_pInt
@@ -381,10 +381,10 @@ subroutine plastic_phenopowerlaw_init
    dot%gamma_twin => plasticState(p)%dotState(startIndex:endIndex,:)
    plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear
 
-   plasticState(p)%state0 = plasticState(p)%state                                                 ! ToDo: this could be done centrally
+   plasticState(p)%state0 = plasticState(p)%state                                                   ! ToDo: this could be done centrally
-   dot%whole => plasticState(p)%dotState
 
    end associate
+
  enddo
 
 end subroutine plastic_phenopowerlaw_init
@@ -392,13 +392,13 @@ end subroutine plastic_phenopowerlaw_init
 
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates plastic velocity gradient and its tangent
-!> @details asumme that deformation by dislocation glide affects twinned and untwinned volume 
+!> @details asummes that deformation by dislocation glide affects twinned and untwinned volume
-!  equally (Taylor assumption). Twinning happens only in untwinned volume (
+!  equally (Taylor assumption). Twinning happens only in untwinned volume
 !--------------------------------------------------------------------------------------------------
-subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
+pure subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
 
  implicit none
- real(pReal), dimension(3,3), intent(out) :: &
+ real(pReal), dimension(3,3),     intent(out) :: &
    Lp                                                                                               !< plastic velocity gradient
  real(pReal), dimension(3,3,3,3), intent(out) :: &
    dLp_dMp                                                                                          !< derivative of Lp with respect to the Mandel stress
@@ -412,17 +412,17 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
  integer(pInt) :: &
    i,k,l,m,n
  real(pReal), dimension(param(instance)%totalNslip) :: &
-   dgdot_dtauslip_pos,dgdot_dtauslip_neg, &
+   gdot_slip_pos,gdot_slip_neg, &
-   gdot_slip_pos,gdot_slip_neg
+   dgdot_dtauslip_pos,dgdot_dtauslip_neg
  real(pReal), dimension(param(instance)%totalNtwin) :: &
    gdot_twin,dgdot_dtautwin
 
  Lp = 0.0_pReal
  dLp_dMp = 0.0_pReal
 
- associate(prm => param(instance), stt => state(instance))
+ associate(prm => param(instance))
 
- call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg)
+ call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg,dgdot_dtauslip_pos,dgdot_dtauslip_neg)
  slipSystems: do i = 1_pInt, prm%totalNslip
    Lp = Lp + (gdot_slip_pos(i)+gdot_slip_neg(i))*prm%Schmid_slip(1:3,1:3,i)
    forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
@@ -431,7 +431,7 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
                       + dgdot_dtauslip_neg(i) * prm%Schmid_slip(k,l,i) * prm%nonSchmid_neg(m,n,i)
  enddo slipSystems
 
- call kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtautwin)
+ call kinetics_twin(Mp,instance,of,gdot_twin,dgdot_dtautwin)
  twinSystems: do i = 1_pInt, prm%totalNtwin
    Lp = Lp + gdot_twin(i)*prm%Schmid_twin(1:3,1:3,i)
    forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
@@ -452,7 +452,7 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of)
  implicit none
  real(pReal), dimension(3,3),  intent(in) :: &
    Mp                                                                                               !< Mandel stress
- integer(pInt),              intent(in) :: &
+ integer(pInt),                intent(in) :: &
    instance, &
    of
 
@@ -466,9 +466,8 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of)
    left_SlipSlip,right_SlipSlip, &
    gdot_slip_pos,gdot_slip_neg
 
- associate(prm => param(instance),  stt => state(instance),  dot => dotState(instance))
+ associate(prm => param(instance), stt => state(instance), dot => dotState(instance))
 
- dot%whole(:,of) = 0.0_pReal
  sumGamma = sum(stt%gamma_slip(:,of))
  sumF     = sum(stt%gamma_twin(:,of)/prm%gamma_twin_char)
 
@@ -487,9 +486,9 @@ subroutine plastic_phenopowerlaw_dotState(Mp,instance,of)
 
 !--------------------------------------------------------------------------------------------------
 ! shear rates
- call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg)
+ call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg)
  dot%gamma_slip(:,of) = abs(gdot_slip_pos+gdot_slip_neg)
- call kinetics_twin(prm,stt,of,Mp,dot%gamma_twin(:,of))
+ call kinetics_twin(Mp,instance,of,dot%gamma_twin(:,of))
 
 !--------------------------------------------------------------------------------------------------
 ! hardening
@@ -510,40 +509,137 @@ end subroutine plastic_phenopowerlaw_dotState
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief calculates shear rates on slip systems and derivatives with respect to resolved stress
+!> @brief return array of constitutive results
-!> @details Shear rates are calculated only optionally. 
-! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to 
-! have the optional arguments at the end
 !--------------------------------------------------------------------------------------------------
-pure subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, &
+function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults)
-                           dgdot_dtau_slip_pos,dgdot_dtau_slip_neg)
- use prec, only: &
-  dNeq0
  use math, only: &
    math_mul33xx33
 
  implicit none
- type(tParameters), intent(in) :: &
+ real(pReal), dimension(3,3), intent(in) :: &
-   prm
+   Mp                                                                                               !< Mandel stress
- type(tPhenopowerlawState), intent(in) :: &
+ integer(pInt),               intent(in) :: &
-   stt
+   instance, &
- integer(pInt),     intent(in) :: &
    of
- real(pReal), dimension(prm%totalNslip), intent(out) :: &
+
+ real(pReal), dimension(sum(plastic_phenopowerlaw_sizePostResult(:,instance))) :: &
+   postResults
+
+ integer(pInt) :: &
+   o,c,i
+ real(pReal), dimension(param(instance)%totalNslip) :: &
+   gdot_slip_pos,gdot_slip_neg
+
+ c = 0_pInt
+
+ associate(prm => param(instance), stt => state(instance))
+
+ outputsLoop: do o = 1_pInt,size(prm%outputID)
+   select case(prm%outputID(o))
+
+     case (resistance_slip_ID)
+       postResults(c+1_pInt:c+prm%totalNslip) = stt%xi_slip(1:prm%totalNslip,of)
+       c = c + prm%totalNslip
+     case (accumulatedshear_slip_ID)
+       postResults(c+1_pInt:c+prm%totalNslip) = stt%gamma_slip(1:prm%totalNslip,of)
+       c = c + prm%totalNslip
+     case (shearrate_slip_ID)
+       call kinetics_slip(Mp,instance,of,gdot_slip_pos,gdot_slip_neg)
+       postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg
+       c = c + prm%totalNslip
+     case (resolvedstress_slip_ID)
+       do i = 1_pInt, prm%totalNslip
+         postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i))
+       enddo
+       c = c + prm%totalNslip
+
+     case (resistance_twin_ID)
+       postResults(c+1_pInt:c+prm%totalNtwin) = stt%xi_twin(1:prm%totalNtwin,of)
+       c = c + prm%totalNtwin
+     case (accumulatedshear_twin_ID)
+       postResults(c+1_pInt:c+prm%totalNtwin) = stt%gamma_twin(1:prm%totalNtwin,of)
+       c = c + prm%totalNtwin
+     case (shearrate_twin_ID)
+       call kinetics_twin(Mp,instance,of,postResults(c+1_pInt:c+prm%totalNtwin))
+       c = c + prm%totalNtwin
+     case (resolvedstress_twin_ID)
+       do i = 1_pInt, prm%totalNtwin
+         postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i))
+       enddo
+       c = c + prm%totalNtwin
+
+   end select
+ enddo outputsLoop
+
+ end associate
+
+end function plastic_phenopowerlaw_postResults
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief writes results to HDF5 output file
+!--------------------------------------------------------------------------------------------------
+subroutine plastic_phenopowerlaw_results(instance,group)
+#if defined(PETSc) || defined(DAMASKHDF5)
+ use results
+
+ implicit none
+ integer(pInt), intent(in) :: instance
+ character(len=*) :: group
+ integer(pInt) :: o
+
+ associate(prm => param(instance), stt => state(instance))
+ outputsLoop: do o = 1_pInt,size(prm%outputID)
+   select case(prm%outputID(o))
+     case (resistance_slip_ID)
+       call results_writeVectorDataset(group,stt%xi_slip,'xi_slip','Pa')
+     case (accumulatedshear_slip_ID)
+       call results_writeVectorDataset(group,stt%gamma_slip,'gamma_slip','-')
+   end select
+ enddo outputsLoop
+ end associate
+#else
+ integer(pInt), intent(in) :: instance
+ character(len=*) :: group
+#endif
+end subroutine plastic_phenopowerlaw_results
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Shear rates on slip systems and their derivatives with respect to resolved stress
+!> @details Derivatives are calculated only optionally.
+! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
+! have the optional arguments at the end
+!--------------------------------------------------------------------------------------------------
+pure subroutine kinetics_slip(Mp,instance,of, &
+                              gdot_slip_pos,gdot_slip_neg,dgdot_dtau_slip_pos,dgdot_dtau_slip_neg)
+ use prec, only: &
+   dNeq0
+ use math, only: &
+   math_mul33xx33
+
+ implicit none
+ real(pReal), dimension(3,3),  intent(in) :: &
+   Mp                                                                                               !< Mandel stress
+ integer(pInt),                intent(in) :: &
+   instance, &
+   of
+
+ real(pReal),                  intent(out), dimension(param(instance)%totalNslip) :: &
    gdot_slip_pos, &
    gdot_slip_neg
- real(pReal), dimension(prm%totalNslip), optional, intent(out) :: &
+ real(pReal),                  intent(out), optional, dimension(param(instance)%totalNslip) :: &
    dgdot_dtau_slip_pos, &
    dgdot_dtau_slip_neg
- real(pReal), dimension(3,3), intent(in) :: &
-   Mp
 
- real(pReal), dimension(prm%totalNslip) :: &
+ real(pReal), dimension(param(instance)%totalNslip) :: &
    tau_slip_pos, &
    tau_slip_neg
  integer(pInt) :: i
  logical       :: nonSchmidActive
 
+ associate(prm => param(instance), stt => state(instance))
+
  nonSchmidActive = size(prm%nonSchmidCoeff) > 0_pInt
 
  do i = 1_pInt, prm%totalNslip
@@ -560,7 +656,7 @@ pure subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, &
  end where
 
  where(dNeq0(tau_slip_neg))
-   gdot_slip_neg = 0.5_pReal*prm%gdot0_slip &
+   gdot_slip_neg = prm%gdot0_slip * 0.5_pReal &                                                     ! only used if non-Schmid active, always 1/2
                  * sign(abs(tau_slip_neg/stt%xi_slip(:,of))**prm%n_slip,  tau_slip_neg)
  else where
    gdot_slip_neg = 0.0_pReal
@@ -580,41 +676,43 @@ pure subroutine kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg, &
      dgdot_dtau_slip_neg = 0.0_pReal
    end where
  endif
+ end associate
 
 end subroutine kinetics_slip
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief calculates shear rates on twin systems and derivatives with respect to resolved stress.
+!> @brief Shear rates on twin systems and their derivatives with respect to resolved stress.
 !  twinning is assumed to take place only in untwinned volume.
 !> @details Derivates are calculated only optionally.
 ! NOTE: Against the common convention, the result (i.e. intent(out)) variables are the last to
 ! have the optional arguments at the end.
 !--------------------------------------------------------------------------------------------------
-pure subroutine kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtau_twin)
+pure subroutine kinetics_twin(Mp,instance,of,&
+                              gdot_twin,dgdot_dtau_twin)
  use prec, only: &
   dNeq0
  use math, only: &
    math_mul33xx33
 
  implicit none
- type(tParameters), intent(in) :: &
+ real(pReal), dimension(3,3),  intent(in) :: &
-   prm
+   Mp                                                                                               !< Mandel stress
- type(tPhenopowerlawState), intent(in) :: &
+ integer(pInt),                intent(in) :: &
-   stt
+   instance, &
- integer(pInt),     intent(in) :: &
    of
- real(pReal), dimension(3,3), intent(in) :: &
+
-   Mp
+ real(pReal), dimension(param(instance)%totalNtwin), intent(out) :: &
- real(pReal), dimension(prm%totalNtwin), intent(out) :: &
    gdot_twin
- real(pReal), dimension(prm%totalNtwin), optional, intent(out) :: &
+ real(pReal), dimension(param(instance)%totalNtwin), intent(out), optional :: &
    dgdot_dtau_twin
 
- real(pReal), dimension(prm%totalNtwin) :: &
+ real(pReal), dimension(param(instance)%totalNtwin) :: &
    tau_twin
  integer(pInt) :: i
 
+ associate(prm => param(instance), stt => state(instance))
+
  do i = 1_pInt, prm%totalNtwin
    tau_twin(i)  = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i))
  enddo
@@ -634,75 +732,8 @@ pure subroutine kinetics_twin(prm,stt,of,Mp,gdot_twin,dgdot_dtau_twin)
    end where
  endif
 
-end subroutine kinetics_twin
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief return array of constitutive results
-!--------------------------------------------------------------------------------------------------
-function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults)
- use math, only: &
-   math_mul33xx33
-
- implicit none
- real(pReal), dimension(3,3), intent(in) :: &
-   Mp                                                                                               !< Mandel stress
- integer(pInt),             intent(in) :: &
-   instance, &
-   of
-
- real(pReal), dimension(sum(plastic_phenopowerlaw_sizePostResult(:,instance))) :: &
-   postResults
-
- integer(pInt) :: &
-   o,c,i
- real(pReal), dimension(param(instance)%totalNslip) :: &
-   gdot_slip_pos,gdot_slip_neg
-
- postResults = 0.0_pReal
- c = 0_pInt
- 
- associate( prm => param(instance), stt => state(instance))
-
- outputsLoop: do o = 1_pInt,size(prm%outputID)
-   select case(prm%outputID(o))
-
-     case (resistance_slip_ID)
-       postResults(c+1_pInt:c+prm%totalNslip) = stt%xi_slip(1:prm%totalNslip,of)
-       c = c + prm%totalNslip
-     case (accumulatedshear_slip_ID)
-       postResults(c+1_pInt:c+prm%totalNslip) = stt%gamma_slip(1:prm%totalNslip,of)
-       c = c + prm%totalNslip
-     case (shearrate_slip_ID)
-       call kinetics_slip(prm,stt,of,Mp,gdot_slip_pos,gdot_slip_neg)
-       postResults(c+1_pInt:c+prm%totalNslip) = gdot_slip_pos+gdot_slip_neg
-       c = c + prm%totalNslip
-     case (resolvedstress_slip_ID)
-       do i = 1_pInt, prm%totalNslip
-         postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_slip(1:3,1:3,i))
-       enddo
-       c = c + prm%totalNslip
-
-     case (resistance_twin_ID)
-       postResults(c+1_pInt:c+prm%totalNtwin) = stt%xi_twin(1:prm%totalNtwin,of)
-       c = c + prm%totalNtwin
-     case (accumulatedshear_twin_ID)
-       postResults(c+1_pInt:c+prm%totalNtwin) = stt%gamma_twin(1:prm%totalNtwin,of)
-       c = c + prm%totalNtwin
-     case (shearrate_twin_ID)
-       call kinetics_twin(prm,stt,of,Mp,postResults(c+1_pInt:c+prm%totalNtwin))
-       c = c + prm%totalNtwin
-     case (resolvedstress_twin_ID)
-       do i = 1_pInt, prm%totalNtwin
-         postResults(c+i) = math_mul33xx33(Mp,prm%Schmid_twin(1:3,1:3,i))
-       enddo
-       c = c + prm%totalNtwin
-
-   end select
- enddo outputsLoop
- 
  end associate
 
-end function plastic_phenopowerlaw_postResults
+end subroutine kinetics_twin
 
 end module plastic_phenopowerlaw

src/porosity_none.f90

@@ -1,60 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for constant porosity
-!--------------------------------------------------------------------------------------------------
-module porosity_none
-
- implicit none
- private
- 
- public :: &
-   porosity_none_init
-
-contains
-
-!--------------------------------------------------------------------------------------------------
-!> @brief allocates all neccessary fields, reads information from material configuration file
-!--------------------------------------------------------------------------------------------------
-subroutine porosity_none_init()
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use prec, only: &
-   pReal, &
-   pInt 
- use IO, only: &
-   IO_timeStamp
- use material
- use config
- 
- implicit none
- integer(pInt) :: &
-   homog, &
-   NofMyHomog
-
- write(6,'(/,a)')   ' <<<+-  porosity_'//POROSITY_none_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
-
- initializeInstances: do homog = 1_pInt, material_Nhomogenization
-   
-   myhomog: if (porosity_type(homog) == POROSITY_none_ID) then
-     NofMyHomog = count(material_homog == homog)
-     porosityState(homog)%sizeState = 0_pInt
-     porosityState(homog)%sizePostResults = 0_pInt
-     allocate(porosityState(homog)%state0   (0_pInt,NofMyHomog), source=0.0_pReal)
-     allocate(porosityState(homog)%subState0(0_pInt,NofMyHomog), source=0.0_pReal)
-     allocate(porosityState(homog)%state    (0_pInt,NofMyHomog), source=0.0_pReal)
-     
-     deallocate(porosity(homog)%p)
-     allocate  (porosity(homog)%p(1), source=porosity_initialPhi(homog))
-     
-   endif myhomog
- enddo initializeInstances
-
-
-end subroutine porosity_none_init
-
-end module porosity_none

src/porosity_phasefield.f90

@@ -1,448 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for phase field modelling of pore nucleation and growth
-!> @details phase field model for pore nucleation and growth based on vacancy clustering
-!--------------------------------------------------------------------------------------------------
-module porosity_phasefield
- use prec, only: &
-   pReal, &
-   pInt
-
- implicit none
- private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   porosity_phasefield_sizePostResults                                                           !< cumulative size of post results
-
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
-   porosity_phasefield_sizePostResult                                                            !< size of each post result output
-
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
-   porosity_phasefield_output                                                                    !< name of each post result output
-   
- integer(pInt),                       dimension(:),           allocatable, target, public :: &
-   porosity_phasefield_Noutput                                                                   !< number of outputs per instance of this porosity 
-
- enum, bind(c) 
-   enumerator :: undefined_ID, &
-                 porosity_ID
- end enum
- integer(kind(undefined_ID)),         dimension(:,:),         allocatable,          private :: & 
-   porosity_phasefield_outputID                                                                  !< ID of each post result output
-
-
- public :: &
-   porosity_phasefield_init, &
-   porosity_phasefield_getFormationEnergy, &
-   porosity_phasefield_getSurfaceEnergy, &
-   porosity_phasefield_getSourceAndItsTangent, &
-   porosity_phasefield_getDiffusion33, &
-   porosity_phasefield_getMobility, &
-   porosity_phasefield_putPorosity, &
-   porosity_phasefield_postResults
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine porosity_phasefield_init(fileUnit)
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use IO, only: &
-   IO_read, &
-   IO_lc, &
-   IO_getTag, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_warning, &
-   IO_error, &
-   IO_timeStamp, &
-   IO_EOF
- use material, only: &
-   porosity_type, &
-   porosity_typeInstance, &
-   homogenization_Noutput, &
-   POROSITY_phasefield_label, &
-   POROSITY_phasefield_ID, &
-   material_homog, & 
-   mappingHomogenization, & 
-   porosityState, &
-   porosityMapping, &
-   porosity, &
-   porosity_initialPhi
- use config, only: &
-   material_partHomogenization, &
-   material_partPhase
-
- implicit none
- integer(pInt), intent(in) :: fileUnit
-
- integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
- integer(pInt) :: sizeState
- integer(pInt) :: NofMyHomog   
- character(len=65536) :: &
-   tag  = '', &
-   line = ''
-
- write(6,'(/,a)')   ' <<<+-  porosity_'//POROSITY_phasefield_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
- 
- maxNinstance = int(count(porosity_type == POROSITY_phasefield_ID),pInt)
- if (maxNinstance == 0_pInt) return
- 
- allocate(porosity_phasefield_sizePostResults(maxNinstance),                               source=0_pInt)
- allocate(porosity_phasefield_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
- allocate(porosity_phasefield_output         (maxval(homogenization_Noutput),maxNinstance))
-          porosity_phasefield_output = ''
- allocate(porosity_phasefield_outputID       (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
- allocate(porosity_phasefield_Noutput        (maxNinstance),                               source=0_pInt) 
-
- rewind(fileUnit)
- section = 0_pInt
- do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
-   line = IO_read(fileUnit)
- enddo
- 
- parsingHomog: do while (trim(line) /= IO_EOF)                                                       ! read through sections of homog 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 homog section
-     section = section + 1_pInt                                                                     ! advance homog section counter
-     cycle                                                                                          ! skip to next line
-   endif
-
-   if (section > 0_pInt ) then; if (porosity_type(section) == POROSITY_phasefield_ID) then          ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
-
-     instance = porosity_typeInstance(section)                                                      ! which instance of my porosity is present homog
-     chunkPos = IO_stringPos(line)
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
-     select case(tag)
-       case ('(output)')
-         select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
-           case ('porosity')
-             porosity_phasefield_Noutput(instance) = porosity_phasefield_Noutput(instance) + 1_pInt
-             porosity_phasefield_outputID(porosity_phasefield_Noutput(instance),instance) = porosity_ID
-             porosity_phasefield_output(porosity_phasefield_Noutput(instance),instance) = &
-                                                       IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-          end select
-
-     end select
-   endif; endif
- enddo parsingHomog
- 
- initializeInstances: do section = 1_pInt, size(porosity_type)
-   if (porosity_type(section) == POROSITY_phasefield_ID) then
-     NofMyHomog=count(material_homog==section)
-     instance = porosity_typeInstance(section)
-
-!--------------------------------------------------------------------------------------------------
-!  Determine size of postResults array
-     outputsLoop: do o = 1_pInt,porosity_phasefield_Noutput(instance)
-       select case(porosity_phasefield_outputID(o,instance))
-         case(porosity_ID)
-           mySize = 1_pInt
-       end select
- 
-       if (mySize > 0_pInt) then  ! any meaningful output found
-          porosity_phasefield_sizePostResult(o,instance) = mySize
-          porosity_phasefield_sizePostResults(instance)  = porosity_phasefield_sizePostResults(instance) + mySize
-       endif
-     enddo outputsLoop
-
-! allocate state arrays
-     sizeState = 0_pInt
-     porosityState(section)%sizeState = sizeState
-     porosityState(section)%sizePostResults = porosity_phasefield_sizePostResults(instance)
-     allocate(porosityState(section)%state0   (sizeState,NofMyHomog))
-     allocate(porosityState(section)%subState0(sizeState,NofMyHomog))
-     allocate(porosityState(section)%state    (sizeState,NofMyHomog))
-
-     nullify(porosityMapping(section)%p)
-     porosityMapping(section)%p => mappingHomogenization(1,:,:)
-     deallocate(porosity(section)%p)
-     allocate(porosity(section)%p(NofMyHomog), source=porosity_initialPhi(section))
-     
-   endif
- 
- enddo initializeInstances
-end subroutine porosity_phasefield_init
-
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized vacancy formation energy
-!--------------------------------------------------------------------------------------------------
-function porosity_phasefield_getFormationEnergy(ip,el)
- use lattice, only: &
-   lattice_vacancyFormationEnergy, &
-   lattice_vacancyVol
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase
- use mesh, only: &
-   mesh_element
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal) :: &
-   porosity_phasefield_getFormationEnergy
- integer(pInt) :: &
-   grain
-  
- porosity_phasefield_getFormationEnergy = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mesh_element(3,el))
-   porosity_phasefield_getFormationEnergy = porosity_phasefield_getFormationEnergy + &
-    lattice_vacancyFormationEnergy(material_phase(grain,ip,el))/ &
-    lattice_vacancyVol(material_phase(grain,ip,el))
- enddo
-
- porosity_phasefield_getFormationEnergy = &
-   porosity_phasefield_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
- 
-end function porosity_phasefield_getFormationEnergy
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized pore surface energy (normalized by characteristic length)
-!--------------------------------------------------------------------------------------------------
-function porosity_phasefield_getSurfaceEnergy(ip,el)
- use lattice, only: &
-   lattice_vacancySurfaceEnergy
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase
- use mesh, only: &
-   mesh_element
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal) :: &
-   porosity_phasefield_getSurfaceEnergy
- integer(pInt) :: &
-   grain
-  
- porosity_phasefield_getSurfaceEnergy = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mesh_element(3,el))
-   porosity_phasefield_getSurfaceEnergy = porosity_phasefield_getSurfaceEnergy + &
-    lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
- enddo
-
- porosity_phasefield_getSurfaceEnergy = &
-   porosity_phasefield_getSurfaceEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
- 
-end function porosity_phasefield_getSurfaceEnergy
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief  calculates homogenized local driving force for pore nucleation and growth  
-!--------------------------------------------------------------------------------------------------
-subroutine porosity_phasefield_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
- use math, only : &
-   math_mul33x33, &
-   math_mul66x6, &
-   math_Mandel33to6, &
-   math_transpose33, &
-   math_I3
- use material, only: &
-   homogenization_Ngrains, &
-   material_homog, &
-   material_phase, &
-   phase_NstiffnessDegradations, &
-   phase_stiffnessDegradation, &
-   vacancyConc, &
-   vacancyfluxMapping, &
-   damage, &
-   damageMapping, &
-   STIFFNESS_DEGRADATION_damage_ID
- use crystallite, only: &
-   crystallite_Fe
- use constitutive, only: &
-   constitutive_homogenizedC  
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in) :: &
-   phi
- integer(pInt) :: &
-   phase, &
-   grain, &
-   homog, &
-   mech
- real(pReal) :: &
-   phiDot, dPhiDot_dPhi, Cv, W_e, strain(6), C(6,6)  
-
- homog = material_homog(ip,el)
- Cv = vacancyConc(homog)%p(vacancyfluxMapping(homog)%p(ip,el))
-
- W_e = 0.0_pReal
- do grain = 1, homogenization_Ngrains(homog)
-   phase = material_phase(grain,ip,el)
-   strain = math_Mandel33to6(math_mul33x33(math_transpose33(crystallite_Fe(1:3,1:3,grain,ip,el)), &
-                                           crystallite_Fe(1:3,1:3,grain,ip,el)) - math_I3)/2.0_pReal
-   C = constitutive_homogenizedC(grain,ip,el)
-   do mech = 1_pInt, phase_NstiffnessDegradations(phase)
-     select case(phase_stiffnessDegradation(mech,phase))
-       case (STIFFNESS_DEGRADATION_damage_ID)
-         C = damage(homog)%p(damageMapping(homog)%p(ip,el))* &
-             damage(homog)%p(damageMapping(homog)%p(ip,el))* &
-             C                                        
-     
-     end select
-   enddo                                                 
-   W_e = W_e + sum(abs(strain*math_mul66x6(C,strain)))
- enddo
- W_e = W_e/real(homogenization_Ngrains(homog),pReal)
- 
- phiDot = 2.0_pReal*(1.0_pReal - phi)*(1.0_pReal - Cv)*(1.0_pReal - Cv) - &
-          2.0_pReal*phi*(W_e + Cv*porosity_phasefield_getFormationEnergy(ip,el))/ &
-                                  porosity_phasefield_getSurfaceEnergy  (ip,el)
- dPhiDot_dPhi = - 2.0_pReal*(1.0_pReal - Cv)*(1.0_pReal - Cv) &
-                - 2.0_pReal*(W_e + Cv*porosity_phasefield_getFormationEnergy(ip,el))/ &
-                                      porosity_phasefield_getSurfaceEnergy  (ip,el)
-
-end subroutine porosity_phasefield_getSourceAndItsTangent
-
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized nonlocal diffusion tensor in reference configuration
-!--------------------------------------------------------------------------------------------------
-function porosity_phasefield_getDiffusion33(ip,el)
- use lattice, only: &
-   lattice_PorosityDiffusion33
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase, &
-   mappingHomogenization
- use crystallite, only: &
-   crystallite_push33ToRef
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), dimension(3,3) :: &
-   porosity_phasefield_getDiffusion33
- integer(pInt) :: &
-   homog, &
-   grain
-   
- homog  = mappingHomogenization(2,ip,el)
- porosity_phasefield_getDiffusion33 = 0.0_pReal  
- do grain = 1, homogenization_Ngrains(homog)
-   porosity_phasefield_getDiffusion33 = porosity_phasefield_getDiffusion33 + &
-     crystallite_push33ToRef(grain,ip,el,lattice_PorosityDiffusion33(1:3,1:3,material_phase(grain,ip,el)))
- enddo
-
- porosity_phasefield_getDiffusion33 = &
-   porosity_phasefield_getDiffusion33/real(homogenization_Ngrains(homog),pReal)
- 
-end function porosity_phasefield_getDiffusion33
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief Returns homogenized phase field mobility 
-!--------------------------------------------------------------------------------------------------
-real(pReal) function porosity_phasefield_getMobility(ip,el)
- use mesh, only: &
-   mesh_element
- use lattice, only: &
-   lattice_PorosityMobility
- use material, only: &
-   material_phase, &
-   homogenization_Ngrains
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- integer(pInt) :: &
-   ipc
- 
- porosity_phasefield_getMobility = 0.0_pReal
-                                                
- do ipc = 1, homogenization_Ngrains(mesh_element(3,el))
-   porosity_phasefield_getMobility = porosity_phasefield_getMobility &
-                                   + lattice_PorosityMobility(material_phase(ipc,ip,el))
- enddo
-
- porosity_phasefield_getMobility = &
-   porosity_phasefield_getMobility/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
-
-end function porosity_phasefield_getMobility
-
-!--------------------------------------------------------------------------------------------------
-!> @brief updates porosity with solution from phasefield PDE
-!--------------------------------------------------------------------------------------------------
-subroutine porosity_phasefield_putPorosity(phi,ip,el)
- use material, only: &
-   material_homog, &
-   porosityMapping, &
-   porosity
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in) :: &
-   phi
- integer(pInt) :: &
-   homog, &
-   offset
- 
- homog  = material_homog(ip,el)
- offset = porosityMapping(homog)%p(ip,el)
- porosity(homog)%p(offset) = phi
-
-end subroutine porosity_phasefield_putPorosity
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief return array of porosity results
-!--------------------------------------------------------------------------------------------------
-function porosity_phasefield_postResults(ip,el)
- use material, only: &
-   mappingHomogenization, &
-   porosity_typeInstance, &
-   porosity
-
- implicit none
- integer(pInt),              intent(in) :: &
-   ip, &                                                                                            !< integration point
-   el                                                                                               !< element
- real(pReal), dimension(porosity_phasefield_sizePostResults(porosity_typeInstance(mappingHomogenization(2,ip,el)))) :: &
-   porosity_phasefield_postResults
-
- integer(pInt) :: &
-   instance, homog, offset, o, c
-   
- homog     = mappingHomogenization(2,ip,el)
- offset    = mappingHomogenization(1,ip,el)
- instance  = porosity_typeInstance(homog)
-
- c = 0_pInt
- porosity_phasefield_postResults = 0.0_pReal
-
- do o = 1_pInt,porosity_phasefield_Noutput(instance)
-    select case(porosity_phasefield_outputID(o,instance))
- 
-      case (porosity_ID)
-        porosity_phasefield_postResults(c+1_pInt) = porosity(homog)%p(offset)
-        c = c + 1
-    end select
- enddo
-end function porosity_phasefield_postResults
-
-end module porosity_phasefield

src/quit.f90

@@ -23,6 +23,8 @@ subroutine quit(stop_id)
  integer(pInt) :: error = 0_pInt
  PetscErrorCode :: ierr = 0
 
+ call h5open_f(hdferr)
+ if (hdferr /= 0) write(6,'(a,i5)') ' Error in h5open_f',hdferr                                     ! prevents error if not opened yet
  call h5close_f(hdferr)
  if (hdferr /= 0) write(6,'(a,i5)') ' Error in h5close_f',hdferr
 

src/results.f90

@@ -0,0 +1,974 @@
+!--------------------------------------------------------------------------------------------------
+!> @author Vitesh Shah, Max-Planck-Institut für Eisenforschung GmbH
+!> @author Yi-Chin Yang, Max-Planck-Institut für Eisenforschung GmbH
+!> @author Jennifer Nastola, Max-Planck-Institut für Eisenforschung GmbH
+!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
+!--------------------------------------------------------------------------------------------------
+module results
+  use prec
+  use IO
+  use HDF5
+  use HDF5_utilities
+#ifdef PETSc
+  use PETSC
+#endif
+
+ implicit none
+ private
+ integer(HID_T), public, protected :: tempCoordinates, tempResults
+ integer(HID_T), private :: resultsFile, currentIncID, plist_id
+
+
+ public :: &
+   results_init, &
+   results_openJobFile, &
+   results_closeJobFile, &
+   results_addIncrement, &
+   results_addGroup, &
+   results_openGroup, &
+   results_writeVectorDataset, &
+   results_setLink, &
+   results_removeLink
+contains
+
+subroutine results_init
+ use, intrinsic :: &
+   iso_fortran_env  ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
+ use DAMASK_interface, only: &
+   getSolverJobName
+ implicit none
+
+ write(6,'(/,a)') ' <<<+-  results init  -+>>>'
+#include "compilation_info.f90"
+
+ call HDF5_closeFile(HDF5_openFile(trim(getSolverJobName())//'.hdf5','w',.true.))
+
+end subroutine results_init
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief opens the results file to append data
+!--------------------------------------------------------------------------------------------------
+subroutine results_openJobFile()
+ use DAMASK_interface, only: &
+   getSolverJobName
+
+ implicit none
+ character(len=pStringLen) :: commandLine
+
+ resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.)
+ call HDF5_addAttribute(resultsFile,'DADF5',0.1_pReal)
+ call HDF5_addAttribute(resultsFile,'DAMASK',DAMASKVERSION)
+ call get_command(commandLine)
+ call HDF5_addAttribute(resultsFile,'call',trim(commandLine))
+ 
+end subroutine results_openJobFile
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief closes the results file
+!--------------------------------------------------------------------------------------------------
+subroutine results_closeJobFile()
+ implicit none
+
+ call HDF5_closeFile(resultsFile)
+
+end subroutine results_closeJobFile
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief closes the results file
+!--------------------------------------------------------------------------------------------------
+subroutine results_addIncrement(inc,time)
+ 
+ implicit none
+ integer(pInt), intent(in) :: inc
+ real(pReal),   intent(in) :: time
+ character(len=pStringLen) :: incChar
+
+ write(incChar,*) inc
+ call HDF5_closeGroup(results_addGroup(trim('inc'//trim(adjustl(incChar)))))
+ call results_setLink(trim('inc'//trim(adjustl(incChar))),'current')
+ call HDF5_addAttribute(resultsFile,'time/s',time,trim('inc'//trim(adjustl(incChar))))
+
+end subroutine results_addIncrement
+
+!--------------------------------------------------------------------------------------------------
+!> @brief open a group from the results file
+!--------------------------------------------------------------------------------------------------
+integer(HID_T) function results_openGroup(groupName)
+
+ implicit none
+ character(len=*), intent(in) :: groupName
+ 
+ results_openGroup = HDF5_openGroup(resultsFile,groupName)
+
+end function results_openGroup
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief adds a new group to the results file
+!--------------------------------------------------------------------------------------------------
+integer(HID_T) function results_addGroup(groupName)
+
+ implicit none
+ character(len=*), intent(in) :: groupName
+ 
+ results_addGroup = HDF5_addGroup(resultsFile,groupName)
+
+end function results_addGroup
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief set link to object in results file
+!--------------------------------------------------------------------------------------------------
+subroutine results_setLink(path,link)
+ use hdf5_utilities, only: &
+  HDF5_setLink
+
+ implicit none
+ character(len=*), intent(in) :: path, link
+
+ call HDF5_setLink(resultsFile,path,link)
+
+end subroutine results_setLink
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief remove link to an object
+!--------------------------------------------------------------------------------------------------
+subroutine results_removeLink(link)
+ use hdf5
+
+ implicit none
+ character(len=*), intent(in) :: link
+ integer                      :: hdferr
+
+ call h5ldelete_f(resultsFile,link, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'results_removeLink: h5ldelete_soft_f ('//trim(link)//')')
+
+end subroutine results_removeLink
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief stores a vector dataset in a group
+!--------------------------------------------------------------------------------------------------
+subroutine results_writeVectorDataset(group,dataset,label,SIunit)
+
+ implicit none
+ character(len=*), intent(in)                 :: SIunit,label,group
+ real(pReal),      intent(inout), dimension(:,:) :: dataset
+ integer(HID_T)        :: groupHandle
+ 
+ groupHandle = results_openGroup(group)
+ call HDF5_write(groupHandle,dataset,label)
+ if (HDF5_objectExists(groupHandle,label)) &
+   call HDF5_addAttribute(groupHandle,'Unit',SIunit,label)
+ call HDF5_closeGroup(groupHandle)
+
+end subroutine results_writeVectorDataset
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief adds the unique mapping from spatial position and constituent ID to results
+!--------------------------------------------------------------------------------------------------
+subroutine HDF5_mappingPhase(mapping,mapping2,Nconstituents,material_phase,phase_name,dataspace_size,mpiOffset,mpiOffset_phase)
+ use hdf5
+
+ implicit none
+ integer(pInt),    intent(in)                   :: Nconstituents, dataspace_size, mpiOffset
+ integer(pInt),    intent(in), dimension(:)     :: mapping, mapping2
+ character(len=*), intent(in), dimension(:)     :: phase_name
+ integer(pInt),    intent(in), dimension(:)     :: mpiOffset_phase
+ integer(pInt),    intent(in), dimension(:,:,:) :: material_phase
+
+ character(len=len(phase_name(1))), dimension(:), allocatable :: namesNA
+ character(len=len(phase_name(1)))                            :: a
+ character(len=*),                  parameter                 :: n = "NULL"
+
+ integer(pInt)   :: hdferr, NmatPoints, i, j, k
+ integer(HID_T)  :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace
+ integer(HID_T)  :: dt5_id      ! Memory datatype identifier
+ integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size
+
+ integer(HSIZE_T),  dimension(2)                :: counter
+ integer(HSSIZE_T), dimension(2)                :: fileOffset
+ integer(pInt),     dimension(:,:), allocatable :: arrOffset
+
+ a = n
+ allocate(namesNA(0:size(phase_name)),source=[a,phase_name])
+ NmatPoints = size(mapping,1)/Nconstituents
+ mapping_ID = results_openGroup("current/mapGeometry")
+
+ allocate(arrOffset(Nconstituents,NmatPoints))
+ do i=1_pInt, NmatPoints
+   do k=1_pInt, Nconstituents
+     do j=1_pInt, size(phase_name)
+       if(material_phase(k,1,i) == j) &
+         arrOffset(k,i) = mpiOffset_phase(j)
+     enddo
+   enddo
+ enddo
+
+!--------------------------------------------------------------------------------------------------
+! create dataspace
+ call h5screate_simple_f(2, int([Nconstituents,dataspace_size],HSIZE_T), space_id, hdferr, &
+                            int([Nconstituents,dataspace_size],HSIZE_T))
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping')
+
+!--------------------------------------------------------------------------------------------------
+! compound type
+     ! First calculate total size by calculating sizes of each member
+     !
+     CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr)
+     typesize = len(phase_name(1))
+     CALL h5tset_size_f(dt5_id, typesize, hdferr)
+     CALL h5tget_size_f(dt5_id, type_sizec, hdferr)
+     CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr)
+     type_size = type_sizec + type_sizei
+ call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id')
+
+ call h5tinsert_f(dtype_id, "Name",          0_SIZE_T, dt5_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 0')
+ call h5tinsert_f(dtype_id, "Position",  type_sizec, H5T_STD_I32LE, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 2')
+
+!--------------------------------------------------------------------------------------------------
+! create Dataset
+ call h5dcreate_f(mapping_id, 'constitutive', dtype_id, space_id, dset_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase')
+
+!--------------------------------------------------------------------------------------------------
+! Create memory types (one compound datatype for each member)
+ call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f instance_id')
+ call h5tinsert_f(name_id, "Name",        0_SIZE_T, dt5_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f instance_id')
+
+ call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f position_id')
+ call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f position_id')
+
+!--------------------------------------------------------------------------------------------------
+! Define and select hyperslabs
+ counter(1)    = Nconstituents                  ! how big i am
+ counter(2)    = NmatPoints
+ fileOffset(1) = 0                              ! where i start to write my data
+ fileOffset(2) = mpiOffset
+
+ call h5screate_simple_f(2, counter, memspace, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5screate_simple_f')
+ call h5dget_space_f(dset_id, space_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dget_space_f')
+ call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sselect_hyperslab_f')
+
+!--------------------------------------------------------------------------------------------------
+ ! Create property list for collective dataset write
+#ifdef PETSc
+ call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pcreate_f')
+ call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pset_dxpl_mpio_f')
+#endif
+
+!--------------------------------------------------------------------------------------------------
+! write data by fields in the datatype. Fields order is not important.
+ call h5dwrite_f(dset_id, name_id, reshape(namesNA(mapping),[Nconstituents,NmatPoints]), &
+                          int([Nconstituents,  dataspace_size],HSIZE_T), hdferr, &
+                          file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f position_id')
+
+ call h5dwrite_f(dset_id, position_id, reshape(mapping2-1_pInt,[Nconstituents,NmatPoints])+arrOffset, &
+                          int([Nconstituents,  dataspace_size],HSIZE_T), hdferr, &
+                          file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f instance_id')
+
+!--------------------------------------------------------------------------------------------------
+! close types, dataspaces
+ call h5tclose_f(dtype_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dtype_id')
+ call h5tclose_f(position_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f position_id')
+ call h5tclose_f(name_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f name_id  ')
+ call h5tclose_f(dt5_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dt5_id')
+ call h5dclose_f(dset_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dclose_f')
+ call h5sclose_f(space_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f space_id')
+ call h5sclose_f(memspace, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f memspace')
+ call h5pclose_f(plist_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pclose_f')
+ call HDF5_closeGroup(mapping_ID)
+
+end subroutine HDF5_mappingPhase
+
+!--------------------------------------------------------------------------------------------------
+!> @brief adds the backward mapping from spatial position and constituent ID to results
+!--------------------------------------------------------------------------------------------------
+subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dataspace_size,mpiOffset,mpiOffset_phase)
+ use hdf5
+
+ implicit none
+ integer(pInt),    intent(in), dimension(:,:,:) :: material_phase, phasememberat
+ character(len=*), intent(in), dimension(:)     :: phase_name
+ integer(pInt),    intent(in), dimension(:)     :: dataspace_size, mpiOffset_phase
+ integer(pInt),    intent(in)                   :: mpiOffset
+
+ integer(pInt)   :: hdferr, NmatPoints, Nconstituents, i, j
+ integer(HID_T)  :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace
+ integer(SIZE_T) :: type_size
+
+ integer(pInt), dimension(:,:), allocatable :: arr
+
+ integer(HSIZE_T),  dimension(1) :: counter
+ integer(HSSIZE_T), dimension(1) :: fileOffset
+
+ character(len=64) :: phaseID
+
+ Nconstituents = size(phasememberat,1)
+ NmatPoints = count(material_phase /=0_pInt)/Nconstituents
+
+ allocate(arr(2,NmatPoints*Nconstituents))
+
+ do i=1_pInt, NmatPoints
+   do j=Nconstituents-1_pInt, 0_pInt, -1_pInt
+     arr(1,Nconstituents*i-j) = i-1_pInt
+   enddo
+ enddo
+ arr(2,:) = pack(material_phase,material_phase/=0_pInt)
+
+ do i=1_pInt, size(phase_name)
+   write(phaseID, '(i0)') i
+   mapping_ID = results_openGroup('/current/constitutive/'//trim(phaseID)//'_'//phase_name(i))
+   NmatPoints = count(material_phase == i)
+
+!--------------------------------------------------------------------------------------------------
+  ! create dataspace
+   call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, &
+                              int([dataspace_size(i)],HSIZE_T))
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping')
+
+!--------------------------------------------------------------------------------------------------
+  ! compound type
+   call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr)
+   call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id')
+
+   call h5tinsert_f(dtype_id, "Position",          0_SIZE_T, H5T_STD_I32LE, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f 0')
+
+!--------------------------------------------------------------------------------------------------
+  ! create Dataset
+   call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase')
+
+!--------------------------------------------------------------------------------------------------
+  ! Create memory types (one compound datatype for each member)
+   call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tcreate_f position_id')
+   call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f position_id')
+
+!--------------------------------------------------------------------------------------------------
+  ! Define and select hyperslabs
+   counter = NmatPoints                       ! how big i am
+   fileOffset = mpiOffset_phase(i)            ! where i start to write my data
+
+   call h5screate_simple_f(1, counter, memspace, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5screate_simple_f')
+   call h5dget_space_f(dset_id, space_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dget_space_f')
+   call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sselect_hyperslab_f')
+
+!--------------------------------------------------------------------------------------------------
+ ! Create property list for collective dataset write
+#ifdef PETSc
+   call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pcreate_f')
+   call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pset_dxpl_mpio_f')
+#endif
+
+!--------------------------------------------------------------------------------------------------
+  ! write data by fields in the datatype. Fields order is not important.
+   call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset, int([dataspace_size(i)],HSIZE_T),&
+                              hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dwrite_f instance_id')
+
+!--------------------------------------------------------------------------------------------------
+  !close types, dataspaces
+   call h5tclose_f(dtype_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f dtype_id')
+   call h5tclose_f(position_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f position_id')
+   call h5dclose_f(dset_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dclose_f')
+   call h5sclose_f(space_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f space_id')
+   call h5sclose_f(memspace, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f memspace')
+   call h5pclose_f(plist_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pclose_f')
+   call HDF5_closeGroup(mapping_ID)
+
+ enddo
+
+end subroutine HDF5_backwardMappingPhase
+
+!--------------------------------------------------------------------------------------------------
+!> @brief adds the unique mapping from spatial position and constituent ID to results
+!--------------------------------------------------------------------------------------------------
+subroutine HDF5_mappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog)
+ use hdf5
+
+ implicit none
+ integer(pInt),    intent(in), dimension(:,:) :: material_homog, homogmemberat
+ character(len=*), intent(in), dimension(:)   :: homogenization_name
+ integer(pInt),    intent(in), dimension(:)   :: mpiOffset_homog
+ integer(pInt),    intent(in)                 :: dataspace_size, mpiOffset
+
+ integer(pInt)   :: hdferr, NmatPoints, i, j
+ integer(HID_T)  :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace
+
+ integer(HID_T)  :: dt5_id      ! Memory datatype identifier
+ integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size
+
+ integer(HSIZE_T),  dimension(1)              :: counter
+ integer(HSSIZE_T), dimension(1)              :: fileOffset
+ integer(pInt),     dimension(:), allocatable :: arrOffset
+
+ NmatPoints = count(material_homog /=0_pInt)
+ mapping_ID = results_openGroup("current/mapGeometry")
+
+ allocate(arrOffset(NmatPoints))
+ do i=1_pInt, NmatPoints
+   do j=1_pInt, size(homogenization_name)
+     if(material_homog(1,i) == j) &
+       arrOffset(i) = mpiOffset_homog(j)
+   enddo
+ enddo
+
+!--------------------------------------------------------------------------------------------------
+! create dataspace
+ call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, &
+                            int([dataspace_size],HSIZE_T))
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping')
+
+!--------------------------------------------------------------------------------------------------
+! compound type
+     ! First calculate total size by calculating sizes of each member
+     !
+     CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr)
+     typesize = len(homogenization_name(1))
+     CALL h5tset_size_f(dt5_id, typesize, hdferr)
+     CALL h5tget_size_f(dt5_id, type_sizec, hdferr)
+     CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr)
+     type_size = type_sizec + type_sizei
+ call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id')
+
+ call h5tinsert_f(dtype_id, "Name",          0_SIZE_T, dt5_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 0')
+ call h5tinsert_f(dtype_id, "Position",  type_sizec, H5T_STD_I32LE, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 2')
+
+!--------------------------------------------------------------------------------------------------
+! create Dataset
+ call h5dcreate_f(mapping_id, 'homogenization', dtype_id, space_id, dset_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog')
+
+!--------------------------------------------------------------------------------------------------
+! Create memory types (one compound datatype for each member)
+ call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f instance_id')
+ call h5tinsert_f(name_id, "Name",        0_SIZE_T, dt5_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f instance_id')
+
+ call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f position_id')
+ call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f position_id')
+
+!--------------------------------------------------------------------------------------------------
+! Define and select hyperslabs
+ counter = NmatPoints                    ! how big i am
+ fileOffset = mpiOffset                  ! where i start to write my data
+
+ call h5screate_simple_f(1, counter, memspace, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5screate_simple_f')
+ call h5dget_space_f(dset_id, space_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dget_space_f')
+ call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sselect_hyperslab_f')
+
+!--------------------------------------------------------------------------------------------------
+! Create property list for collective dataset write
+#ifdef PETSc
+ call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pcreate_f')
+ call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pset_dxpl_mpio_f')
+#endif
+
+!--------------------------------------------------------------------------------------------------
+! write data by fields in the datatype. Fields order is not important.
+ call h5dwrite_f(dset_id, name_id, homogenization_name(pack(material_homog,material_homog/=0_pInt)), &
+                          int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, &
+                          mem_space_id = memspace, xfer_prp = plist_id)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f position_id')
+
+ call h5dwrite_f(dset_id, position_id, pack(homogmemberat-1_pInt,homogmemberat/=0_pInt) + arrOffset, &
+                          int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, &
+                          mem_space_id = memspace, xfer_prp = plist_id)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f instance_id')
+
+!--------------------------------------------------------------------------------------------------
+!close types, dataspaces
+call h5tclose_f(dtype_id, hdferr)
+if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dtype_id')
+call h5tclose_f(position_id, hdferr)
+if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f position_id')
+call h5tclose_f(name_id, hdferr)
+if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f name_id  ')
+call h5tclose_f(dt5_id, hdferr)
+if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dt5_id')
+call h5dclose_f(dset_id, hdferr)
+if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dclose_f')
+call h5sclose_f(space_id, hdferr)
+if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f space_id')
+call h5sclose_f(memspace, hdferr)
+if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f memspace')
+call h5pclose_f(plist_id, hdferr)
+if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pclose_f')
+call HDF5_closeGroup(mapping_ID)
+
+end subroutine HDF5_mappingHomog
+
+!--------------------------------------------------------------------------------------------------
+!> @brief adds the backward mapping from spatial position and constituent ID to results
+!--------------------------------------------------------------------------------------------------
+subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog)
+ use hdf5
+
+ implicit none
+ integer(pInt),    intent(in), dimension(:,:) :: material_homog, homogmemberat
+ character(len=*), intent(in), dimension(:)   :: homogenization_name
+ integer(pInt),    intent(in), dimension(:)   :: dataspace_size, mpiOffset_homog
+ integer(pInt),    intent(in)                 :: mpiOffset
+
+ integer(pInt)   :: hdferr, NmatPoints, i
+ integer(HID_T)  :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace
+ integer(SIZE_T) :: type_size
+
+ integer(pInt),     dimension(:,:), allocatable :: arr
+
+ integer(HSIZE_T),  dimension(1) :: counter
+ integer(HSSIZE_T), dimension(1) :: fileOffset
+
+ character(len=64) :: homogID
+
+ NmatPoints = count(material_homog /=0_pInt)
+ allocate(arr(2,NmatPoints))
+
+ arr(1,:) = (/(i, i=0_pint,NmatPoints-1_pInt)/)
+ arr(2,:) = pack(material_homog,material_homog/=0_pInt)
+
+ do i=1_pInt, size(homogenization_name)
+   write(homogID, '(i0)') i
+   mapping_ID = results_openGroup('/current/homogenization/'//trim(homogID)//'_'//homogenization_name(i))
+
+!--------------------------------------------------------------------------------------------------
+  ! create dataspace
+   call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, &
+                              int([dataspace_size(i)],HSIZE_T))
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping')
+
+!--------------------------------------------------------------------------------------------------
+  ! compound type
+   call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr)
+   call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id')
+
+   call h5tinsert_f(dtype_id, "Position",          0_SIZE_T, H5T_STD_I32LE, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f 0')
+
+!--------------------------------------------------------------------------------------------------
+  ! create Dataset
+   call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog')
+
+!--------------------------------------------------------------------------------------------------
+  ! Create memory types (one compound datatype for each member)
+   call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tcreate_f position_id')
+   call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f position_id')
+
+!--------------------------------------------------------------------------------------------------
+  ! Define and select hyperslabs
+   counter = NmatPoints                           ! how big i am
+   fileOffset = mpiOffset_homog(i)                ! where i start to write my data
+
+   call h5screate_simple_f(1, counter, memspace, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5screate_simple_f')
+   call h5dget_space_f(dset_id, space_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dget_space_f')
+   call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sselect_hyperslab_f')
+
+!--------------------------------------------------------------------------------------------------
+ ! Create property list for collective dataset write
+#ifdef PETSc
+   call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pcreate_f')
+   call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pset_dxpl_mpio_f')
+#endif
+
+!--------------------------------------------------------------------------------------------------
+  ! write data by fields in the datatype. Fields order is not important.
+   call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset,int([dataspace_size(i)],HSIZE_T),&
+                   hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dwrite_f instance_id')
+
+!--------------------------------------------------------------------------------------------------
+  !close types, dataspaces
+   call h5tclose_f(dtype_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f dtype_id')
+   call h5tclose_f(position_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f position_id')
+   call h5dclose_f(dset_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dclose_f')
+   call h5sclose_f(space_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f space_id')
+   call h5sclose_f(memspace, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f memspace')
+   call h5pclose_f(plist_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pclose_f')
+   call HDF5_closeGroup(mapping_ID)
+
+ enddo
+
+end subroutine HDF5_backwardMappingHomog
+
+!--------------------------------------------------------------------------------------------------
+!> @brief adds the unique mapping from spatial position and constituent ID to results
+!--------------------------------------------------------------------------------------------------
+subroutine HDF5_mappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst)
+ use hdf5
+
+ implicit none
+ integer(pInt),    intent(in), dimension(:,:)   :: crystalliteAt
+ integer(pInt),    intent(in), dimension(:,:,:) :: crystmemberAt
+ character(len=*), intent(in), dimension(:)     :: crystallite_name
+ integer(pInt),    intent(in), dimension(:)     :: mpiOffset_cryst
+ integer(pInt),    intent(in)                   :: dataspace_size, mpiOffset
+
+ integer         :: hdferr
+ integer(pInt)   :: NmatPoints, Nconstituents, i, j
+ integer(HID_T)  :: mapping_id, dtype_id, dset_id, space_id, name_id, plist_id, memspace
+
+ integer(HID_T), dimension(:), allocatable :: position_id
+
+ integer(HID_T)  :: dt5_id      ! Memory datatype identifier
+ integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size
+
+ integer(HSIZE_T),  dimension(1)              :: counter
+ integer(HSSIZE_T), dimension(1)              :: fileOffset
+ integer(pInt),     dimension(:), allocatable :: arrOffset
+
+ character(len=64) :: m
+
+ Nconstituents = size(crystmemberAt,1)
+ NmatPoints = count(crystalliteAt /=0_pInt)
+ mapping_ID = results_openGroup("current/mapGeometry")
+
+ allocate(position_id(Nconstituents))
+
+ allocate(arrOffset(NmatPoints))
+ do i=1_pInt, NmatPoints
+   do j=1_pInt, size(crystallite_name)
+     if(crystalliteAt(1,i) == j) &
+       arrOffset(i) = Nconstituents*mpiOffset_cryst(j)
+   enddo
+ enddo
+
+!--------------------------------------------------------------------------------------------------
+! create dataspace
+ call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, &
+                            int([dataspace_size],HSIZE_T))
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping')
+
+!--------------------------------------------------------------------------------------------------
+! compound type
+     ! First calculate total size by calculating sizes of each member
+     !
+     CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr)
+     typesize = len(crystallite_name(1))
+     CALL h5tset_size_f(dt5_id, typesize, hdferr)
+     CALL h5tget_size_f(dt5_id, type_sizec, hdferr)
+     CALL h5tget_size_f(H5T_STD_I32LE, type_sizei, hdferr)
+     type_size = type_sizec + type_sizei*Nconstituents
+ call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id')
+
+ call h5tinsert_f(dtype_id, "Name",          0_SIZE_T, dt5_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 0')
+ do i=1_pInt, Nconstituents
+   write(m, '(i0)') i
+   call h5tinsert_f(dtype_id, "Position "//trim(m),  type_sizec+(i-1)*type_sizei, H5T_STD_I32LE, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 2 '//trim(m))
+ enddo
+
+!--------------------------------------------------------------------------------------------------
+! create Dataset
+ call h5dcreate_f(mapping_id, 'crystallite', dtype_id, space_id, dset_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite')
+
+!--------------------------------------------------------------------------------------------------
+! Create memory types (one compound datatype for each member)
+ call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f instance_id')
+ call h5tinsert_f(name_id, "Name",        0_SIZE_T, dt5_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f instance_id')
+
+ do i=1_pInt, Nconstituents
+   write(m, '(i0)') i
+   call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id(i), hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f position_id')
+   call h5tinsert_f(position_id(i), "Position "//trim(m), 0_SIZE_T, H5T_STD_I32LE, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f position_id')
+ enddo
+
+!--------------------------------------------------------------------------------------------------
+! Define and select hyperslabs
+ counter = NmatPoints                    ! how big i am
+ fileOffset = mpiOffset                  ! where i start to write my data
+
+ call h5screate_simple_f(1, counter, memspace, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5screate_simple_f')
+ call h5dget_space_f(dset_id, space_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dget_space_f')
+ call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sselect_hyperslab_f')
+
+!--------------------------------------------------------------------------------------------------
+ ! Create property list for collective dataset write
+#ifdef PETSc
+ call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pcreate_f')
+ call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pset_dxpl_mpio_f')
+#endif
+
+!--------------------------------------------------------------------------------------------------
+! write data by fields in the datatype. Fields order is not important.
+ call h5dwrite_f(dset_id, name_id, crystallite_name(pack(crystalliteAt,crystalliteAt/=0_pInt)), &
+                          int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, &
+                          mem_space_id = memspace, xfer_prp = plist_id)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f position_id')
+
+ do i=1_pInt, Nconstituents
+   call h5dwrite_f(dset_id, position_id(i), pack(crystmemberAt(i,:,:)-1_pInt,crystmemberAt(i,:,:)/=0_pInt)+arrOffset,&
+                            int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, &
+                            mem_space_id = memspace, xfer_prp = plist_id)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f instance_id')
+ enddo
+
+!--------------------------------------------------------------------------------------------------
+!close types, dataspaces
+ call h5tclose_f(dtype_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dtype_id')
+ do i=1_pInt, Nconstituents
+   call h5tclose_f(position_id(i), hdferr)
+ enddo
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f position_id')
+ call h5tclose_f(name_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f name_id')
+ call h5tclose_f(dt5_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dt5_id')
+ call h5dclose_f(dset_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dclose_f')
+ call h5sclose_f(space_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f space_id')
+ call h5sclose_f(memspace, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f memspace')
+ call h5pclose_f(plist_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pclose_f')
+ call HDF5_closeGroup(mapping_ID)
+
+end subroutine HDF5_mappingCrystallite
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief adds the backward mapping from spatial position and constituent ID to results
+!--------------------------------------------------------------------------------------------------
+subroutine HDF5_backwardMappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst)
+ use hdf5
+
+ implicit none
+ integer(pInt),    intent(in), dimension(:,:)   :: crystalliteAt
+ integer(pInt),    intent(in), dimension(:,:,:) :: crystmemberAt
+ character(len=*), intent(in), dimension(:)     :: crystallite_name
+ integer(pInt),    intent(in), dimension(:)     :: dataspace_size, mpiOffset_cryst
+ integer(pInt),    intent(in)                   :: mpiOffset
+
+ integer         :: hdferr
+ integer(pInt)   :: NmatPoints, Nconstituents, i, j
+ integer(HID_T)  :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace
+ integer(SIZE_T) :: type_size
+
+ integer(pInt), dimension(:,:), allocatable     :: h_arr, arr
+
+ integer(HSIZE_T),  dimension(1) :: counter
+ integer(HSSIZE_T), dimension(1) :: fileOffset
+
+ character(len=64) :: crystallID
+
+ Nconstituents = size(crystmemberAt,1)
+ NmatPoints = count(crystalliteAt /=0_pInt)
+
+ allocate(h_arr(2,NmatPoints))
+ allocate(arr(2,Nconstituents*NmatPoints))
+
+ h_arr(1,:) = (/(i, i=0_pInt,NmatPoints-1_pInt)/)
+ h_arr(2,:) = pack(crystalliteAt,crystalliteAt/=0_pInt)
+
+ do i=1_pInt, NmatPoints
+   do j=Nconstituents-1_pInt, 0_pInt, -1_pInt
+     arr(1,Nconstituents*i-j) = h_arr(1,i)
+     arr(2,Nconstituents*i-j) = h_arr(2,i)
+   enddo
+ enddo
+
+ do i=1_pInt, size(crystallite_name)
+   if (crystallite_name(i) == 'none') cycle
+   write(crystallID, '(i0)') i
+   mapping_ID = results_openGroup('/current/crystallite/'//trim(crystallID)//'_'//crystallite_name(i))
+   NmatPoints = count(crystalliteAt == i)
+
+!--------------------------------------------------------------------------------------------------
+  ! create dataspace
+   call h5screate_simple_f(1, int([Nconstituents*dataspace_size(i)],HSIZE_T), space_id, hdferr, &
+                              int([Nconstituents*dataspace_size(i)],HSIZE_T))
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping')
+
+!--------------------------------------------------------------------------------------------------
+  ! compound type
+   call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr)
+   call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id')
+
+   call h5tinsert_f(dtype_id, "Position",          0_SIZE_T, H5T_STD_I32LE, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f 0')
+
+!--------------------------------------------------------------------------------------------------
+  ! create Dataset
+   call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite')
+
+!--------------------------------------------------------------------------------------------------
+  ! Create memory types
+   call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tcreate_f position_id')
+   call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f position_id')
+
+!--------------------------------------------------------------------------------------------------
+  ! Define and select hyperslabs
+   counter = Nconstituents*NmatPoints                       ! how big i am
+   fileOffset = Nconstituents*mpiOffset_cryst(i)            ! where i start to write my data
+
+   call h5screate_simple_f(1, counter, memspace, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5screate_simple_f')
+   call h5dget_space_f(dset_id, space_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dget_space_f')
+   call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sselect_hyperslab_f')
+
+!--------------------------------------------------------------------------------------------------
+ ! Create property list for collective dataset write
+#ifdef PETSc
+   call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pcreate_f')
+   call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pset_dxpl_mpio_f')
+#endif
+
+!--------------------------------------------------------------------------------------------------
+  ! write data by fields in the datatype. Fields order is not important.
+   call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i) + mpiOffset,&
+                              int([Nconstituents*dataspace_size(i)],HSIZE_T), hdferr, file_space_id = space_id, &
+                              mem_space_id = memspace, xfer_prp = plist_id)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dwrite_f instance_id')
+
+!--------------------------------------------------------------------------------------------------
+  !close types, dataspaces
+   call h5tclose_f(dtype_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f dtype_id')
+   call h5tclose_f(position_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f position_id')
+   call h5dclose_f(dset_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dclose_f')
+   call h5sclose_f(space_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f space_id')
+   call h5sclose_f(memspace, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f memspace')
+   call h5pclose_f(plist_id, hdferr)
+   if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pclose_f')
+   call HDF5_closeGroup(mapping_ID)
+
+ enddo
+
+end subroutine HDF5_backwardMappingCrystallite
+
+!--------------------------------------------------------------------------------------------------
+!> @brief adds the unique cell to node mapping
+!--------------------------------------------------------------------------------------------------
+subroutine HDF5_mappingCells(mapping)
+ use hdf5
+
+ implicit none
+ integer(pInt), intent(in), dimension(:) :: mapping
+
+ integer        :: hdferr, Nnodes
+ integer(HID_T) :: mapping_id, dset_id, space_id
+
+ Nnodes=size(mapping)
+ mapping_ID = results_openGroup("mapping")
+
+!--------------------------------------------------------------------------------------------------
+! create dataspace
+ call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, &
+                            int([Nnodes],HSIZE_T))
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5screate_simple_f')
+
+!--------------------------------------------------------------------------------------------------
+! create Dataset
+ call h5dcreate_f(mapping_id, "Cell",H5T_NATIVE_INTEGER, space_id, dset_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells')
+
+!--------------------------------------------------------------------------------------------------
+! write data by fields in the datatype. Fields order is not important.
+ call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, mapping, int([Nnodes],HSIZE_T), hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5dwrite_f instance_id')
+
+!--------------------------------------------------------------------------------------------------
+!close types, dataspaces
+ call h5dclose_f(dset_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5dclose_f')
+ call h5sclose_f(space_id, hdferr)
+ if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5sclose_f')
+ call HDF5_closeGroup(mapping_ID)
+
+end subroutine HDF5_mappingCells
+
+
+end module results

src/source_damage_isoBrittle.f90

@@ -262,10 +262,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
    sourceState, &
    material_homog, &
    phase_NstiffnessDegradations, &
-   phase_stiffnessDegradation, &
+   phase_stiffnessDegradation
-   porosity, &
-   porosityMapping, &  
-   STIFFNESS_DEGRADATION_porosity_ID
  use math, only : &
    math_mul33x33, &
    math_mul66x6, &
@@ -296,14 +293,6 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
  sourceOffset = source_damage_isoBrittle_offset(phase)
 
  stiffness = C                                            
- do mech = 1_pInt, phase_NstiffnessDegradations(phase)
-   select case(phase_stiffnessDegradation(mech,phase))
-     case (STIFFNESS_DEGRADATION_porosity_ID)
-       stiffness = porosity(material_homog(ip,el))%p(porosityMapping(material_homog(ip,el))%p(ip,el))* &
-                   porosity(material_homog(ip,el))%p(porosityMapping(material_homog(ip,el))%p(ip,el))* &
-                   stiffness 
-   end select
- enddo                                                 
  strain = 0.5_pReal*math_Mandel33to6(math_mul33x33(math_transpose33(Fe),Fe)-math_I3)
 
  strainenergy = 2.0_pReal*sum(strain*math_mul66x6(stiffness,strain))/ &

src/source_vacancy_irradiation.f90

@@ -1,248 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for vacancy generation due to irradiation
-!> @details to be done
-!--------------------------------------------------------------------------------------------------
-module source_vacancy_irradiation
- use prec, only: &
-   pReal, &
-   pInt
-
- implicit none
- private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   source_vacancy_irradiation_sizePostResults, &                                                        !< cumulative size of post results
-   source_vacancy_irradiation_offset, &                                                                 !< which source is my current damage mechanism?
-   source_vacancy_irradiation_instance                                                                  !< instance of damage source mechanism
-
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
-   source_vacancy_irradiation_sizePostResult                                                            !< size of each post result output
-
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
-   source_vacancy_irradiation_output                                                                    !< name of each post result output
-   
- integer(pInt),                       dimension(:),           allocatable, target, public :: &
-   source_vacancy_irradiation_Noutput                                                                   !< number of outputs per instance of this damage 
-
- real(pReal),                         dimension(:),           allocatable,        private :: &
-   source_vacancy_irradiation_cascadeProb, &
-   source_vacancy_irradiation_cascadeVolume
-
- public :: &
-   source_vacancy_irradiation_init, &
-   source_vacancy_irradiation_deltaState, &
-   source_vacancy_irradiation_getRateAndItsTangent
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine source_vacancy_irradiation_init(fileUnit)
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use debug, only: &
-   debug_level,&
-   debug_constitutive,&
-   debug_levelBasic
- use IO, only: &
-   IO_read, &
-   IO_lc, &
-   IO_getTag, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_warning, &
-   IO_error, &
-   IO_timeStamp, &
-   IO_EOF
- use material, only: &
-   phase_source, &
-   phase_Nsources, &
-   phase_Noutput, &
-   SOURCE_vacancy_irradiation_label, &
-   SOURCE_vacancy_irradiation_ID, &
-   material_phase, &  
-   sourceState
- use config, only: &
-   material_Nphase, &
-   MATERIAL_partPhase
- use numerics,only: &
-   numerics_integrator
-
- implicit none
- integer(pInt), intent(in) :: fileUnit
-
- integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
- integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
- integer(pInt) :: NofMyPhase   
- character(len=65536) :: &
-   tag  = '', &
-   line = ''
-
- write(6,'(/,a)')   ' <<<+-  source_'//SOURCE_vacancy_irradiation_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
- 
- maxNinstance = int(count(phase_source == SOURCE_vacancy_irradiation_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(source_vacancy_irradiation_offset(material_Nphase), source=0_pInt)
- allocate(source_vacancy_irradiation_instance(material_Nphase), source=0_pInt)
- do phase = 1, material_Nphase
-   source_vacancy_irradiation_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_irradiation_ID)
-   do source = 1, phase_Nsources(phase)
-     if (phase_source(source,phase) == source_vacancy_irradiation_ID) &
-       source_vacancy_irradiation_offset(phase) = source
-   enddo    
- enddo
-   
- allocate(source_vacancy_irradiation_sizePostResults(maxNinstance),                     source=0_pInt)
- allocate(source_vacancy_irradiation_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
- allocate(source_vacancy_irradiation_output(maxval(phase_Noutput),maxNinstance))
-          source_vacancy_irradiation_output = ''
- allocate(source_vacancy_irradiation_Noutput(maxNinstance),                             source=0_pInt) 
- allocate(source_vacancy_irradiation_cascadeProb(maxNinstance),                         source=0.0_pReal) 
- allocate(source_vacancy_irradiation_cascadeVolume(maxNinstance),                       source=0.0_pReal) 
-
- 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 phase section
-     phase = phase + 1_pInt                                                                         ! advance phase section counter
-     cycle                                                                                          ! skip to next line
-   endif
-
-   if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_irradiation_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
-
-     instance = source_vacancy_irradiation_instance(phase)                                          ! which instance of my vacancy is present phase
-     chunkPos = IO_stringPos(line)
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
-     select case(tag)
-       case ('irradiation_cascadeprobability')
-         source_vacancy_irradiation_cascadeProb(instance) = IO_floatValue(line,chunkPos,2_pInt)
-
-       case ('irradiation_cascadevolume')
-         source_vacancy_irradiation_cascadeVolume(instance) = IO_floatValue(line,chunkPos,2_pInt)
-
-     end select
-   endif; endif
- enddo parsingFile
- 
- initializeInstances: do phase = 1_pInt, material_Nphase
-   if (any(phase_source(:,phase) == SOURCE_vacancy_irradiation_ID)) then
-     NofMyPhase=count(material_phase==phase)
-     instance = source_vacancy_irradiation_instance(phase)
-     sourceOffset = source_vacancy_irradiation_offset(phase)
-
-     sizeDotState              =   2_pInt
-     sizeDeltaState            =   2_pInt
-     sizeState                 =   2_pInt
-     sourceState(phase)%p(sourceOffset)%sizeState =       sizeState
-     sourceState(phase)%p(sourceOffset)%sizeDotState =    sizeDotState
-     sourceState(phase)%p(sourceOffset)%sizeDeltaState =  sizeDeltaState
-     sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_irradiation_sizePostResults(instance)
-     allocate(sourceState(phase)%p(sourceOffset)%aTolState           (sizeState),                source=0.1_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%state0              (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%partionedState0     (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%subState0           (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%state               (sizeState,NofMyPhase),     source=0.0_pReal)
-
-     allocate(sourceState(phase)%p(sourceOffset)%dotState            (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%deltaState        (sizeDeltaState,NofMyPhase),  source=0.0_pReal)
-     if (any(numerics_integrator == 1_pInt)) then
-       allocate(sourceState(phase)%p(sourceOffset)%previousDotState  (sizeDotState,NofMyPhase),  source=0.0_pReal)
-       allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     endif
-     if (any(numerics_integrator == 4_pInt)) &
-       allocate(sourceState(phase)%p(sourceOffset)%RK4dotState       (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     if (any(numerics_integrator == 5_pInt)) &
-       allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState    (6,sizeDotState,NofMyPhase),source=0.0_pReal)      
-
-   endif
- 
- enddo initializeInstances
-end subroutine source_vacancy_irradiation_init
-
-!--------------------------------------------------------------------------------------------------
-!> @brief calculates derived quantities from state
-!--------------------------------------------------------------------------------------------------
-subroutine source_vacancy_irradiation_deltaState(ipc, ip, el)
- use material, only: &
-   phaseAt, phasememberAt, &
-   sourceState
-
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< component-ID of integration point
-   ip, &                                                                                            !< integration point
-   el                                                                                               !< element
- integer(pInt) :: &
-   phase, constituent, sourceOffset
- real(pReal) :: &
-   randNo   
-
- phase       = phaseAt(ipc,ip,el)
- constituent = phasememberAt(ipc,ip,el)
- sourceOffset = source_vacancy_irradiation_offset(phase)
-
- call random_number(randNo)
- sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
-   randNo - sourceState(phase)%p(sourceOffset)%state(1,constituent)
- call random_number(randNo)
- sourceState(phase)%p(sourceOffset)%deltaState(2,constituent) = &
-   randNo - sourceState(phase)%p(sourceOffset)%state(2,constituent)
-
-end subroutine source_vacancy_irradiation_deltaState
-
-!--------------------------------------------------------------------------------------------------
-!> @brief returns local vacancy generation rate 
-!--------------------------------------------------------------------------------------------------
-subroutine source_vacancy_irradiation_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el)
- use material, only: &
-   phaseAt, phasememberAt, &
-   sourceState
-
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< grain number
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), intent(out) :: &
-   CvDot, dCvDot_dCv
- integer(pInt) :: &
-   instance, phase, constituent, sourceOffset 
-
- phase = phaseAt(ipc,ip,el)
- constituent = phasememberAt(ipc,ip,el)
- instance = source_vacancy_irradiation_instance(phase)
- sourceOffset = source_vacancy_irradiation_offset(phase)
- 
- CvDot = 0.0_pReal
- dCvDot_dCv = 0.0_pReal
- if (sourceState(phase)%p(sourceOffset)%state0(1,constituent) < source_vacancy_irradiation_cascadeProb(instance)) &
-   CvDot = sourceState(phase)%p(sourceOffset)%state0(2,constituent)*source_vacancy_irradiation_cascadeVolume(instance)
- 
-end subroutine source_vacancy_irradiation_getRateAndItsTangent
- 
-end module source_vacancy_irradiation

src/source_vacancy_phenoplasticity.f90

@@ -1,210 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for vacancy generation due to plasticity
-!> @details to be done
-!--------------------------------------------------------------------------------------------------
-module source_vacancy_phenoplasticity
- use prec, only: &
-   pReal, &
-   pInt
-
- implicit none
- private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   source_vacancy_phenoplasticity_sizePostResults, &                                                        !< cumulative size of post results
-   source_vacancy_phenoplasticity_offset, &                                                                 !< which source is my current damage mechanism?
-   source_vacancy_phenoplasticity_instance                                                                  !< instance of damage source mechanism
-
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
-   source_vacancy_phenoplasticity_sizePostResult                                                            !< size of each post result output
-
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
-   source_vacancy_phenoplasticity_output                                                                    !< name of each post result output
-   
- integer(pInt),                       dimension(:),           allocatable, target, public :: &
-   source_vacancy_phenoplasticity_Noutput                                                                   !< number of outputs per instance of this damage 
-
- real(pReal),                         dimension(:),           allocatable,        private :: &
-   source_vacancy_phenoplasticity_rateCoeff
-
- public :: &
-   source_vacancy_phenoplasticity_init, &
-   source_vacancy_phenoplasticity_getRateAndItsTangent
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine source_vacancy_phenoplasticity_init(fileUnit)
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use debug, only: &
-   debug_level,&
-   debug_constitutive,&
-   debug_levelBasic
- use IO, only: &
-   IO_read, &
-   IO_lc, &
-   IO_getTag, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_warning, &
-   IO_error, &
-   IO_timeStamp, &
-   IO_EOF
- use material, only: &
-   phase_source, &
-   phase_Nsources, &
-   phase_Noutput, &
-   SOURCE_vacancy_phenoplasticity_label, &
-   SOURCE_vacancy_phenoplasticity_ID, &
-   material_phase, &  
-   sourceState
- use config, only: &
-   material_Nphase, &
-   MATERIAL_partPhase
- use numerics,only: &
-   numerics_integrator
-
- implicit none
- integer(pInt), intent(in) :: fileUnit
-
- integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
- integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
- integer(pInt) :: NofMyPhase   
- character(len=65536) :: &
-   tag  = '', &
-   line = ''
-
- write(6,'(/,a)')   ' <<<+-  source_'//SOURCE_vacancy_phenoplasticity_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
- 
- maxNinstance = int(count(phase_source == SOURCE_vacancy_phenoplasticity_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(source_vacancy_phenoplasticity_offset(material_Nphase), source=0_pInt)
- allocate(source_vacancy_phenoplasticity_instance(material_Nphase), source=0_pInt)
- do phase = 1, material_Nphase
-   source_vacancy_phenoplasticity_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_phenoplasticity_ID)
-   do source = 1, phase_Nsources(phase)
-     if (phase_source(source,phase) == source_vacancy_phenoplasticity_ID) &
-       source_vacancy_phenoplasticity_offset(phase) = source
-   enddo    
- enddo
-   
- allocate(source_vacancy_phenoplasticity_sizePostResults(maxNinstance),                     source=0_pInt)
- allocate(source_vacancy_phenoplasticity_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
- allocate(source_vacancy_phenoplasticity_output(maxval(phase_Noutput),maxNinstance))
-          source_vacancy_phenoplasticity_output = ''
- allocate(source_vacancy_phenoplasticity_Noutput(maxNinstance),                             source=0_pInt) 
- allocate(source_vacancy_phenoplasticity_rateCoeff(maxNinstance),                           source=0.0_pReal) 
-
- 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 phase section
-     phase = phase + 1_pInt                                                                         ! advance phase section counter
-     cycle                                                                                          ! skip to next line
-   endif
-
-   if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_phenoplasticity_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
-
-     instance = source_vacancy_phenoplasticity_instance(phase)                                          ! which instance of my vacancy is present phase
-     chunkPos = IO_stringPos(line)
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
-     select case(tag)
-       case ('phenoplasticity_ratecoeff')
-         source_vacancy_phenoplasticity_rateCoeff(instance) = IO_floatValue(line,chunkPos,2_pInt)
-
-     end select
-   endif; endif
- enddo parsingFile
- 
- initializeInstances: do phase = 1_pInt, material_Nphase
-   if (any(phase_source(:,phase) == SOURCE_vacancy_phenoplasticity_ID)) then
-     NofMyPhase=count(material_phase==phase)
-     instance = source_vacancy_phenoplasticity_instance(phase)
-     sourceOffset = source_vacancy_phenoplasticity_offset(phase)
-
-     sizeDotState              =   0_pInt
-     sizeDeltaState            =   0_pInt
-     sizeState                 =   0_pInt
-     sourceState(phase)%p(sourceOffset)%sizeState =       sizeState
-     sourceState(phase)%p(sourceOffset)%sizeDotState =    sizeDotState
-     sourceState(phase)%p(sourceOffset)%sizeDeltaState =  sizeDeltaState
-     sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_phenoplasticity_sizePostResults(instance)
-     allocate(sourceState(phase)%p(sourceOffset)%aTolState           (sizeState),                source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%state0              (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%partionedState0     (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%subState0           (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%state               (sizeState,NofMyPhase),     source=0.0_pReal)
-
-     allocate(sourceState(phase)%p(sourceOffset)%dotState            (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%deltaState        (sizeDeltaState,NofMyPhase),  source=0.0_pReal)
-     if (any(numerics_integrator == 1_pInt)) then
-       allocate(sourceState(phase)%p(sourceOffset)%previousDotState  (sizeDotState,NofMyPhase),  source=0.0_pReal)
-       allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     endif
-     if (any(numerics_integrator == 4_pInt)) &
-       allocate(sourceState(phase)%p(sourceOffset)%RK4dotState       (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     if (any(numerics_integrator == 5_pInt)) &
-       allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState    (6,sizeDotState,NofMyPhase),source=0.0_pReal)      
-
-   endif
- 
- enddo initializeInstances
-end subroutine source_vacancy_phenoplasticity_init
-
-!--------------------------------------------------------------------------------------------------
-!> @brief returns local vacancy generation rate 
-!--------------------------------------------------------------------------------------------------
-subroutine source_vacancy_phenoplasticity_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el)
- use material, only: &
-   phaseAt, phasememberAt, &
-   plasticState
-
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< grain number
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), intent(out) :: &
-   CvDot, dCvDot_dCv
- integer(pInt) :: &
-   instance, phase, constituent 
-
- phase = phaseAt(ipc,ip,el)
- constituent = phasememberAt(ipc,ip,el)
- instance = source_vacancy_phenoplasticity_instance(phase)
- 
- CvDot = &
-   source_vacancy_phenoplasticity_rateCoeff(instance)* &
-   sum(plasticState(phase)%slipRate(:,constituent))
- dCvDot_dCv = 0.0_pReal  
- 
-end subroutine source_vacancy_phenoplasticity_getRateAndItsTangent
- 
-end module source_vacancy_phenoplasticity

src/source_vacancy_thermalfluc.f90

@@ -1,250 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for vacancy generation due to thermal fluctuations
-!> @details to be done
-!--------------------------------------------------------------------------------------------------
-module source_vacancy_thermalfluc
- use prec, only: &
-   pReal, &
-   pInt
-
- implicit none
- private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   source_vacancy_thermalfluc_sizePostResults, &                                                        !< cumulative size of post results
-   source_vacancy_thermalfluc_offset, &                                                                 !< which source is my current damage mechanism?
-   source_vacancy_thermalfluc_instance                                                                  !< instance of damage source mechanism
-
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
-   source_vacancy_thermalfluc_sizePostResult                                                            !< size of each post result output
-
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
-   source_vacancy_thermalfluc_output                                                                    !< name of each post result output
-   
- integer(pInt),                       dimension(:),           allocatable, target, public :: &
-   source_vacancy_thermalfluc_Noutput                                                                   !< number of outputs per instance of this damage 
-
- real(pReal),                         dimension(:),           allocatable,        private :: &
-   source_vacancy_thermalfluc_amplitude, &
-   source_vacancy_thermalfluc_normVacancyEnergy
-
- public :: &
-   source_vacancy_thermalfluc_init, &
-   source_vacancy_thermalfluc_deltaState, &
-   source_vacancy_thermalfluc_getRateAndItsTangent
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine source_vacancy_thermalfluc_init(fileUnit)
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use debug, only: &
-   debug_level,&
-   debug_constitutive,&
-   debug_levelBasic
- use IO, only: &
-   IO_read, &
-   IO_lc, &
-   IO_getTag, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_warning, &
-   IO_error, &
-   IO_timeStamp, &
-   IO_EOF
- use lattice, only: &
-   lattice_vacancyFormationEnergy
- use material, only: &
-   phase_source, &
-   phase_Nsources, &
-   phase_Noutput, &
-   SOURCE_vacancy_thermalfluc_label, &
-   SOURCE_vacancy_thermalfluc_ID, &
-   material_phase, &  
-   sourceState
- use config, only: &
-   material_Nphase, &
-   MATERIAL_partPhase
- use numerics,only: &
-   numerics_integrator
-
- implicit none
- integer(pInt), intent(in) :: fileUnit
-
- integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: maxNinstance,phase,instance,source,sourceOffset
- integer(pInt) :: sizeState, sizeDotState, sizeDeltaState
- integer(pInt) :: NofMyPhase   
- character(len=65536) :: &
-   tag  = '', &
-   line = ''
-
- write(6,'(/,a)')   ' <<<+-  source_'//SOURCE_vacancy_thermalfluc_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
- 
- maxNinstance = int(count(phase_source == SOURCE_vacancy_thermalfluc_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(source_vacancy_thermalfluc_offset(material_Nphase), source=0_pInt)
- allocate(source_vacancy_thermalfluc_instance(material_Nphase), source=0_pInt)
- do phase = 1, material_Nphase
-   source_vacancy_thermalfluc_instance(phase) = count(phase_source(:,1:phase) == source_vacancy_thermalfluc_ID)
-   do source = 1, phase_Nsources(phase)
-     if (phase_source(source,phase) == source_vacancy_thermalfluc_ID) &
-       source_vacancy_thermalfluc_offset(phase) = source
-   enddo    
- enddo
-   
- allocate(source_vacancy_thermalfluc_sizePostResults(maxNinstance),                     source=0_pInt)
- allocate(source_vacancy_thermalfluc_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt)
- allocate(source_vacancy_thermalfluc_output(maxval(phase_Noutput),maxNinstance))
-          source_vacancy_thermalfluc_output = ''
- allocate(source_vacancy_thermalfluc_Noutput(maxNinstance),                             source=0_pInt) 
- allocate(source_vacancy_thermalfluc_amplitude(maxNinstance),                           source=0.0_pReal) 
- allocate(source_vacancy_thermalfluc_normVacancyEnergy(maxNinstance),                   source=0.0_pReal) 
-
- 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 phase section
-     phase = phase + 1_pInt                                                                         ! advance phase section counter
-     cycle                                                                                          ! skip to next line
-   endif
-
-   if (phase > 0_pInt ) then; if (any(phase_source(:,phase) == SOURCE_vacancy_thermalfluc_ID)) then ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
-
-     instance = source_vacancy_thermalfluc_instance(phase)                                          ! which instance of my vacancy is present phase
-     chunkPos = IO_stringPos(line)
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
-     select case(tag)
-       case ('thermalfluctuation_amplitude')
-         source_vacancy_thermalfluc_amplitude(instance) = IO_floatValue(line,chunkPos,2_pInt)
-
-     end select
-   endif; endif
- enddo parsingFile
- 
- initializeInstances: do phase = 1_pInt, material_Nphase
-   if (any(phase_source(:,phase) == SOURCE_vacancy_thermalfluc_ID)) then
-     NofMyPhase=count(material_phase==phase)
-     instance = source_vacancy_thermalfluc_instance(phase)
-     source_vacancy_thermalfluc_normVacancyEnergy(instance) = &
-       lattice_vacancyFormationEnergy(phase)/1.3806488e-23_pReal
-     sourceOffset = source_vacancy_thermalfluc_offset(phase)
-
-     sizeDotState              =   1_pInt
-     sizeDeltaState            =   1_pInt
-     sizeState                 =   1_pInt
-     sourceState(phase)%p(sourceOffset)%sizeState =       sizeState
-     sourceState(phase)%p(sourceOffset)%sizeDotState =    sizeDotState
-     sourceState(phase)%p(sourceOffset)%sizeDeltaState =  sizeDeltaState
-     sourceState(phase)%p(sourceOffset)%sizePostResults = source_vacancy_thermalfluc_sizePostResults(instance)
-     allocate(sourceState(phase)%p(sourceOffset)%aTolState           (sizeState),                source=0.1_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%state0              (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%partionedState0     (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%subState0           (sizeState,NofMyPhase),     source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%state               (sizeState,NofMyPhase),     source=0.0_pReal)
-
-     allocate(sourceState(phase)%p(sourceOffset)%dotState            (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     allocate(sourceState(phase)%p(sourceOffset)%deltaState        (sizeDeltaState,NofMyPhase),  source=0.0_pReal)
-     if (any(numerics_integrator == 1_pInt)) then
-       allocate(sourceState(phase)%p(sourceOffset)%previousDotState  (sizeDotState,NofMyPhase),  source=0.0_pReal)
-       allocate(sourceState(phase)%p(sourceOffset)%previousDotState2 (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     endif
-     if (any(numerics_integrator == 4_pInt)) &
-       allocate(sourceState(phase)%p(sourceOffset)%RK4dotState       (sizeDotState,NofMyPhase),  source=0.0_pReal)
-     if (any(numerics_integrator == 5_pInt)) &
-       allocate(sourceState(phase)%p(sourceOffset)%RKCK45dotState    (6,sizeDotState,NofMyPhase),source=0.0_pReal)      
-
-   endif
- 
- enddo initializeInstances
-end subroutine source_vacancy_thermalfluc_init
-
-!--------------------------------------------------------------------------------------------------
-!> @brief calculates derived quantities from state
-!--------------------------------------------------------------------------------------------------
-subroutine source_vacancy_thermalfluc_deltaState(ipc, ip, el)
- use material, only: &
-   phaseAt, phasememberAt, &
-   sourceState
-
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< component-ID of integration point
-   ip, &                                                                                            !< integration point
-   el                                                                                               !< element
- integer(pInt) :: &
-   phase, constituent, sourceOffset 
- real(pReal) :: &
-   randNo   
-
- phase       = phaseAt(ipc,ip,el)
- constituent = phasememberAt(ipc,ip,el)
- sourceOffset = source_vacancy_thermalfluc_offset(phase)
-
- call random_number(randNo)
- sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
-   randNo - 0.5_pReal - sourceState(phase)%p(sourceOffset)%state(1,constituent)
-
-end subroutine source_vacancy_thermalfluc_deltaState
-
-!--------------------------------------------------------------------------------------------------
-!> @brief returns local vacancy generation rate 
-!--------------------------------------------------------------------------------------------------
-subroutine source_vacancy_thermalfluc_getRateAndItsTangent(CvDot, dCvDot_dCv, ipc, ip, el)
- use material, only: &
-   phaseAt, phasememberAt, &
-   material_homog, &
-   temperature, &
-   thermalMapping, &
-   sourceState
-
- implicit none
- integer(pInt), intent(in) :: &
-   ipc, &                                                                                           !< grain number
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), intent(out) :: &
-   CvDot, dCvDot_dCv
- integer(pInt) :: &
-   instance, phase, constituent, sourceOffset 
-
- phase = phaseAt(ipc,ip,el)
- constituent = phasememberAt(ipc,ip,el)
- instance = source_vacancy_thermalfluc_instance(phase)
- sourceOffset = source_vacancy_thermalfluc_offset(phase)
- 
- CvDot = source_vacancy_thermalfluc_amplitude(instance)* &
-         sourceState(phase)%p(sourceOffset)%state0(2,constituent)* &
-         exp(-source_vacancy_thermalfluc_normVacancyEnergy(instance)/ &
-              temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el)))
- dCvDot_dCv = 0.0_pReal
- 
-end subroutine source_vacancy_thermalfluc_getRateAndItsTangent
- 
-end module source_vacancy_thermalfluc

src/spectral_mech_Basic.f90

@@ -80,6 +80,7 @@ subroutine basic_init
 #endif
  use IO, only: &
    IO_intOut, &
+   IO_error, &
    IO_read_realFile, &
    IO_timeStamp
  use debug, only: &
@@ -173,7 +174,11 @@ subroutine basic_init
    call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot))
    read (777,rec=1) F_aimDot; close (777)
    F_aim         = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3])                         ! average of F
+   call MPI_Allreduce(MPI_IN_PLACE,F_aim,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
+   if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim')
    F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt                                 ! average of F_lastInc 
+   call MPI_Allreduce(MPI_IN_PLACE,F_aim_lastInc,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
+   if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim_lastInc')
  elseif (restartInc == 0_pInt) then restart
    F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3)                          ! initialize to identity
    F = reshape(F_lastInc,[9,grid(1),grid(2),grid3])

src/spectral_mech_Polarisation.f90

@@ -78,7 +78,6 @@ contains
 
 !--------------------------------------------------------------------------------------------------
 !> @brief allocates all necessary fields and fills them with data, potentially from restart info
-!> @todo use sourced allocation, e.g. allocate(Fdot,source = F_lastInc)
 !--------------------------------------------------------------------------------------------------
 subroutine Polarisation_init
 #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
@@ -88,6 +87,7 @@ subroutine Polarisation_init
 #endif
  use IO, only: &
    IO_intOut, &
+   IO_error, &
    IO_read_realFile, &
    IO_timeStamp
  use debug, only: &
@@ -191,7 +191,11 @@ subroutine Polarisation_init
    call IO_read_realFile(777,'F_aimDot',trim(getSolverJobName()),size(F_aimDot))
    read (777,rec=1) F_aimDot; close (777)
    F_aim         = reshape(sum(sum(sum(F,dim=4),dim=3),dim=2) * wgt, [3,3])                         ! average of F
+   call MPI_Allreduce(MPI_IN_PLACE,F_aim,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
+   if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim')
    F_aim_lastInc = sum(sum(sum(F_lastInc,dim=5),dim=4),dim=3) * wgt                                 ! average of F_lastInc 
+   call MPI_Allreduce(MPI_IN_PLACE,F_aim_lastInc,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
+   if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='F_aim_lastInc')
  elseif (restartInc == 0_pInt) then restart
    F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3)                          ! initialize to identity
    F = reshape(F_lastInc,[9,grid(1),grid(2),grid3])

src/system_routines.f90

@@ -3,11 +3,17 @@
 !> @brief    provides wrappers to C routines
 !--------------------------------------------------------------------------------------------------
 module system_routines
+ use, intrinsic :: ISO_C_Binding, only: &
+   C_INT, &
+   C_CHAR, &
+   C_NULL_CHAR
 
  implicit none
  private
  
  public :: &
+   signalusr1_C, &
+   signalusr2_C, &
    isDirectory, &
    getCWD, &
    getHostName, &
@@ -27,7 +33,7 @@ interface
    use, intrinsic :: ISO_C_Binding, only: &
      C_INT, &
      C_CHAR
-   character(kind=C_CHAR), dimension(1024), intent(out)  :: str                                     ! C string is an array
+   character(kind=C_CHAR), dimension(1024), intent(out) :: str                                      ! C string is an array
    integer(C_INT),intent(out)         :: stat
   end subroutine getCurrentWorkDir_C
 
@@ -35,7 +41,7 @@ interface
    use, intrinsic :: ISO_C_Binding, only: &
      C_INT, &
      C_CHAR
-   character(kind=C_CHAR), dimension(1024), intent(out)  :: str                                     ! C string is an array
+   character(kind=C_CHAR), dimension(1024), intent(out) :: str                                      ! C string is an array
    integer(C_INT),intent(out)         :: stat
   end subroutine getHostName_C
 
@@ -47,8 +53,19 @@ interface
    character(kind=C_CHAR), dimension(1024), intent(in) :: path                                      ! C string is an array
  end function chdir_C
  
-end interface
+ subroutine signalusr1_C(handler) bind(C)
+   use, intrinsic :: ISO_C_Binding, only: &
+     C_FUNPTR
+   type(C_FUNPTR), intent(in), value :: handler
+ end subroutine signalusr1_C
  
+  subroutine signalusr2_C(handler) bind(C)
+   use, intrinsic :: ISO_C_Binding, only: &
+     C_FUNPTR
+   type(C_FUNPTR), intent(in), value :: handler
+ end subroutine signalusr2_C
+
+end interface
 
 contains
 
@@ -56,21 +73,17 @@ contains
 !> @brief figures out if a given path is a directory (and not an ordinary file)
 !--------------------------------------------------------------------------------------------------
 logical function isDirectory(path)
-  use, intrinsic :: ISO_C_Binding, only: &
-    C_INT, &
-    C_CHAR, &
-    C_NULL_CHAR
 
-  implicit none
+ implicit none
-  character(len=*), intent(in) :: path
+ character(len=*), intent(in) :: path
-  character(kind=C_CHAR), dimension(1024) :: strFixedLength
+ character(kind=C_CHAR), dimension(1024) :: strFixedLength                                         ! C string as array
-  integer :: i 
+ integer :: i 
 
-  strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
+ strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
-  do i=1,len(path)                                                                                  ! copy array components
+ do i=1,len(path)                                                                                   ! copy array components
-    strFixedLength(i)=path(i:i)
+   strFixedLength(i)=path(i:i)
-  enddo
+ enddo
-  isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT)
+ isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT)
 
 end function isDirectory
 
@@ -79,29 +92,25 @@ end function isDirectory
 !> @brief gets the current working directory
 !--------------------------------------------------------------------------------------------------
 character(len=1024) function getCWD()
-  use, intrinsic :: ISO_C_Binding, only: &
-    C_INT, &
-    C_CHAR, &
-    C_NULL_CHAR
 
-  implicit none
+ implicit none
-  character(kind=C_CHAR), dimension(1024) :: charArray                                              ! C string is an array
+ character(kind=C_CHAR), dimension(1024) :: charArray                                               ! C string is an array
-  integer(C_INT) :: stat
+ integer(C_INT) :: stat
-  integer :: i
+ integer :: i
 
-  call getCurrentWorkDir_C(charArray,stat)
+ call getCurrentWorkDir_C(charArray,stat)
-  if (stat /= 0_C_INT) then
+ if (stat /= 0_C_INT) then
-    getCWD = 'Error occured when getting currend working directory'
+   getCWD = 'Error occured when getting currend working directory'
-  else
+ else
-    getCWD = repeat('',len(getCWD))
+   getCWD = repeat('',len(getCWD))
-    arrayToString: do i=1,len(getCWD)
+   arrayToString: do i=1,len(getCWD)
-      if (charArray(i) /= C_NULL_CHAR) then
+     if (charArray(i) /= C_NULL_CHAR) then
-        getCWD(i:i)=charArray(i)
+       getCWD(i:i)=charArray(i)
-      else
+     else
-        exit
+       exit
-      endif
+     endif
-    enddo arrayToString
+   enddo arrayToString
-  endif
+ endif
 
 end function getCWD
 
@@ -110,51 +119,42 @@ end function getCWD
 !> @brief gets the current host name
 !--------------------------------------------------------------------------------------------------
 character(len=1024) function getHostName()
-  use, intrinsic :: ISO_C_Binding, only: &
+ implicit none
-    C_INT, &
+ character(kind=C_CHAR), dimension(1024) :: charArray                                              ! C string is an array
-    C_CHAR, &
+ integer(C_INT) :: stat
-    C_NULL_CHAR
+ integer :: i
 
-  implicit none
+ call getHostName_C(charArray,stat)
-  character(kind=C_CHAR), dimension(1024) :: charArray                                              ! C string is an array
+ if (stat /= 0_C_INT) then
-  integer(C_INT) :: stat
+   getHostName = 'Error occured when getting host name'
-  integer :: i
+ else
-
+   getHostName = repeat('',len(getHostName))
-  call getHostName_C(charArray,stat)
+   arrayToString: do i=1,len(getHostName)
-  if (stat /= 0_C_INT) then
+     if (charArray(i) /= C_NULL_CHAR) then
-    getHostName = 'Error occured when getting host name'
+       getHostName(i:i)=charArray(i)
-  else
+     else
-    getHostName = repeat('',len(getHostName))
+       exit
-    arrayToString: do i=1,len(getHostName)
+     endif
-      if (charArray(i) /= C_NULL_CHAR) then
+   enddo arrayToString
-        getHostName(i:i)=charArray(i)
+ endif
-      else
-        exit
-      endif
-    enddo arrayToString
-  endif
 
 end function getHostName
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief changes the current working directory
 !--------------------------------------------------------------------------------------------------
 logical function setCWD(path)
-  use, intrinsic :: ISO_C_Binding, only: &
+ implicit none
-    C_INT, &
+ character(len=*), intent(in) :: path
-    C_CHAR, &
+ character(kind=C_CHAR), dimension(1024) :: strFixedLength                                          ! C string is an array
-    C_NULL_CHAR
+ integer :: i
 
-  implicit none
+ strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
-  character(len=*), intent(in) :: path
+ do i=1,len(path)                                                                                   ! copy array components
-  character(kind=C_CHAR), dimension(1024) :: strFixedLength                                         ! C string is an array
+   strFixedLength(i)=path(i:i)
-  integer :: i
+ enddo
-
+ setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
-  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
 

src/vacancyflux_cahnhilliard.f90

@@ -1,602 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for conservative transport of vacancy concentration field
-!> @details to be done
-!--------------------------------------------------------------------------------------------------
-module vacancyflux_cahnhilliard
- use prec, only: &
-   pReal, &
-   pInt, &
-   group_float
-
- implicit none
- private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   vacancyflux_cahnhilliard_sizePostResults                                                           !< cumulative size of post results
-
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
-   vacancyflux_cahnhilliard_sizePostResult                                                            !< size of each post result output
-
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
-   vacancyflux_cahnhilliard_output                                                                    !< name of each post result output
-   
- integer(pInt),                       dimension(:),           allocatable, target, public :: &
-   vacancyflux_cahnhilliard_Noutput                                                                   !< number of outputs per instance of this damage 
-
- real(pReal),                         dimension(:),           allocatable,        private :: &
-   vacancyflux_cahnhilliard_flucAmplitude
-
- type(group_float),                  dimension(:),           allocatable,        private :: &
-   vacancyflux_cahnhilliard_thermalFluc
-
- real(pReal),                                                 parameter,           private :: &
-   kB = 1.3806488e-23_pReal                                                                          !< Boltzmann constant in J/Kelvin
-
- enum, bind(c) 
-   enumerator :: undefined_ID, &
-                 vacancyConc_ID
- end enum
- integer(kind(undefined_ID)),         dimension(:,:),         allocatable,        private :: & 
-   vacancyflux_cahnhilliard_outputID                                                                  !< ID of each post result output
-
-
- public :: &
-   vacancyflux_cahnhilliard_init, &
-   vacancyflux_cahnhilliard_getSourceAndItsTangent, &
-   vacancyflux_cahnhilliard_getMobility33, &
-   vacancyflux_cahnhilliard_getDiffusion33, &
-   vacancyflux_cahnhilliard_getChemPotAndItsTangent, &
-   vacancyflux_cahnhilliard_putVacancyConcAndItsRate, &
-   vacancyflux_cahnhilliard_postResults
- private :: &
-   vacancyflux_cahnhilliard_getFormationEnergy, &
-   vacancyflux_cahnhilliard_getEntropicCoeff, &
-   vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent  
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine vacancyflux_cahnhilliard_init(fileUnit)
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use IO, only: &
-   IO_read, &
-   IO_lc, &
-   IO_getTag, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_warning, &
-   IO_error, &
-   IO_timeStamp, &
-   IO_EOF
- use material, only: &
-   vacancyflux_type, &
-   vacancyflux_typeInstance, &
-   homogenization_Noutput, &
-   VACANCYFLUX_cahnhilliard_label, &
-   VACANCYFLUX_cahnhilliard_ID, &
-   material_homog, &  
-   mappingHomogenization, &
-   vacancyfluxState, &
-   vacancyfluxMapping, &
-   vacancyConc, &
-   vacancyConcRate, &
-   vacancyflux_initialCv
- use config, only: &
-   material_partPhase, &
-   material_partHomogenization
-
- implicit none
- integer(pInt), intent(in) :: fileUnit
-
- integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o,offset
- integer(pInt) :: sizeState
- integer(pInt) :: NofMyHomog   
- character(len=65536) :: &
-   tag  = '', &
-   line = ''
-
- write(6,'(/,a)')   ' <<<+-  vacancyflux_'//VACANCYFLUX_cahnhilliard_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
- 
- maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_cahnhilliard_ID),pInt)
- if (maxNinstance == 0_pInt) return
- 
- allocate(vacancyflux_cahnhilliard_sizePostResults(maxNinstance),                               source=0_pInt)
- allocate(vacancyflux_cahnhilliard_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
- allocate(vacancyflux_cahnhilliard_output         (maxval(homogenization_Noutput),maxNinstance))
-          vacancyflux_cahnhilliard_output = ''
- allocate(vacancyflux_cahnhilliard_outputID       (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
- allocate(vacancyflux_cahnhilliard_Noutput        (maxNinstance),                               source=0_pInt) 
-
- allocate(vacancyflux_cahnhilliard_flucAmplitude  (maxNinstance))
- allocate(vacancyflux_cahnhilliard_thermalFluc    (maxNinstance))
-
- rewind(fileUnit)
- section = 0_pInt
- do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
-   line = IO_read(fileUnit)
- enddo
- 
- parsingHomog: do while (trim(line) /= IO_EOF)                                                      ! read through sections of homog 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 homog section
-     section = section + 1_pInt                                                                     ! advance homog section counter
-     cycle                                                                                          ! skip to next line
-   endif
-
-   if (section > 0_pInt ) then; if (vacancyflux_type(section) == VACANCYFLUX_cahnhilliard_ID) then  ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
-
-     instance = vacancyflux_typeInstance(section)                                                   ! which instance of my vacancyflux is present homog
-     chunkPos = IO_stringPos(line)
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
-     select case(tag)
-       case ('(output)')
-         select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
-           case ('vacancyconc')
-             vacancyflux_cahnhilliard_Noutput(instance) = vacancyflux_cahnhilliard_Noutput(instance) + 1_pInt
-             vacancyflux_cahnhilliard_outputID(vacancyflux_cahnhilliard_Noutput(instance),instance) = vacancyConc_ID
-             vacancyflux_cahnhilliard_output(vacancyflux_cahnhilliard_Noutput(instance),instance) = &
-                                                       IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-          end select
-
-       case ('vacancyflux_flucamplitude')
-         vacancyflux_cahnhilliard_flucAmplitude(instance) = IO_floatValue(line,chunkPos,2_pInt)
-         
-     end select
-   endif; endif
- enddo parsingHomog
- 
- initializeInstances: do section = 1_pInt, size(vacancyflux_type)
-   if (vacancyflux_type(section) == VACANCYFLUX_cahnhilliard_ID) then
-     NofMyHomog=count(material_homog==section)
-     instance = vacancyflux_typeInstance(section)
-
-!--------------------------------------------------------------------------------------------------
-!  Determine size of postResults array
-     outputsLoop: do o = 1_pInt,vacancyflux_cahnhilliard_Noutput(instance)
-       select case(vacancyflux_cahnhilliard_outputID(o,instance))
-         case(vacancyConc_ID)
-           mySize = 1_pInt
-       end select
- 
-       if (mySize > 0_pInt) then  ! any meaningful output found
-          vacancyflux_cahnhilliard_sizePostResult(o,instance) = mySize
-          vacancyflux_cahnhilliard_sizePostResults(instance)  = vacancyflux_cahnhilliard_sizePostResults(instance) + mySize
-       endif
-     enddo outputsLoop
-
-! allocate state arrays
-     sizeState = 0_pInt
-     vacancyfluxState(section)%sizeState = sizeState
-     vacancyfluxState(section)%sizePostResults = vacancyflux_cahnhilliard_sizePostResults(instance)
-     allocate(vacancyfluxState(section)%state0   (sizeState,NofMyHomog))
-     allocate(vacancyfluxState(section)%subState0(sizeState,NofMyHomog))
-     allocate(vacancyfluxState(section)%state    (sizeState,NofMyHomog))
-     
-     allocate(vacancyflux_cahnhilliard_thermalFluc(instance)%p(NofMyHomog))
-     do offset = 1_pInt, NofMyHomog
-       call random_number(vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset))
-       vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset) = &
-         1.0_pReal - &
-         vacancyflux_cahnhilliard_flucAmplitude(instance)* &
-         (vacancyflux_cahnhilliard_thermalFluc(instance)%p(offset) - 0.5_pReal)
-     enddo  
-
-     nullify(vacancyfluxMapping(section)%p)
-     vacancyfluxMapping(section)%p => mappingHomogenization(1,:,:)
-     deallocate(vacancyConc    (section)%p)
-     allocate  (vacancyConc    (section)%p(NofMyHomog), source=vacancyflux_initialCv(section))
-     deallocate(vacancyConcRate(section)%p)
-     allocate  (vacancyConcRate(section)%p(NofMyHomog), source=0.0_pReal)
-     
-   endif
- 
- enddo initializeInstances
- 
-end subroutine vacancyflux_cahnhilliard_init
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  calculates homogenized vacancy driving forces  
-!--------------------------------------------------------------------------------------------------
-subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el)
- use material, only: &
-   homogenization_Ngrains, &
-   mappingHomogenization, &
-   phaseAt, &
-   phase_source, &
-   phase_Nsources, &
-   SOURCE_vacancy_phenoplasticity_ID, &
-   SOURCE_vacancy_irradiation_ID, &
-   SOURCE_vacancy_thermalfluc_ID
- use source_vacancy_phenoplasticity, only: &
-   source_vacancy_phenoplasticity_getRateAndItsTangent
- use source_vacancy_irradiation, only: &
-   source_vacancy_irradiation_getRateAndItsTangent
- use source_vacancy_thermalfluc, only: &
-   source_vacancy_thermalfluc_getRateAndItsTangent
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in) :: &
-   Cv
- integer(pInt) :: &
-   phase, &
-   grain, &
-   source
- real(pReal) :: &
-   CvDot, dCvDot_dCv, localCvDot, dLocalCvDot_dCv  
-
- CvDot = 0.0_pReal
- dCvDot_dCv = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el))
-   phase = phaseAt(grain,ip,el)
-   do source = 1_pInt, phase_Nsources(phase)
-     select case(phase_source(source,phase))                                                   
-       case (SOURCE_vacancy_phenoplasticity_ID)
-        call source_vacancy_phenoplasticity_getRateAndItsTangent  (localCvDot, dLocalCvDot_dCv, grain, ip,  el)
-
-       case (SOURCE_vacancy_irradiation_ID)
-        call source_vacancy_irradiation_getRateAndItsTangent  (localCvDot, dLocalCvDot_dCv, grain, ip,  el)
-
-       case (SOURCE_vacancy_thermalfluc_ID)
-        call source_vacancy_thermalfluc_getRateAndItsTangent(localCvDot, dLocalCvDot_dCv, grain, ip,  el)
-
-     end select
-     CvDot = CvDot + localCvDot
-     dCvDot_dCv = dCvDot_dCv + dLocalCvDot_dCv
-   enddo  
- enddo
- 
- CvDot = CvDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
- dCvDot_dCv = dCvDot_dCv/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
- 
-end subroutine vacancyflux_cahnhilliard_getSourceAndItsTangent
-
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized vacancy mobility tensor in reference configuration
-!--------------------------------------------------------------------------------------------------
-function vacancyflux_cahnhilliard_getMobility33(ip,el)
- use lattice, only: &
-   lattice_vacancyfluxMobility33
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase
- use mesh, only: &
-   mesh_element
- use crystallite, only: &
-   crystallite_push33ToRef
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), dimension(3,3) :: &
-   vacancyflux_cahnhilliard_getMobility33
- integer(pInt) :: &
-   grain
-  
- vacancyflux_cahnhilliard_getMobility33 = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mesh_element(3,el))
-   vacancyflux_cahnhilliard_getMobility33 = vacancyflux_cahnhilliard_getMobility33 + &
-    crystallite_push33ToRef(grain,ip,el,lattice_vacancyfluxMobility33(:,:,material_phase(grain,ip,el)))
- enddo
-
- vacancyflux_cahnhilliard_getMobility33 = &
-   vacancyflux_cahnhilliard_getMobility33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
- 
-end function vacancyflux_cahnhilliard_getMobility33
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized vacancy diffusion tensor in reference configuration
-!--------------------------------------------------------------------------------------------------
-function vacancyflux_cahnhilliard_getDiffusion33(ip,el)
- use lattice, only: &
-   lattice_vacancyfluxDiffusion33
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase
- use mesh, only: &
-   mesh_element
- use crystallite, only: &
-   crystallite_push33ToRef
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal), dimension(3,3) :: &
-   vacancyflux_cahnhilliard_getDiffusion33
- integer(pInt) :: &
-   grain
-  
- vacancyflux_cahnhilliard_getDiffusion33 = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mesh_element(3,el))
-   vacancyflux_cahnhilliard_getDiffusion33 = vacancyflux_cahnhilliard_getDiffusion33 + &
-    crystallite_push33ToRef(grain,ip,el,lattice_vacancyfluxDiffusion33(:,:,material_phase(grain,ip,el)))
- enddo
-
- vacancyflux_cahnhilliard_getDiffusion33 = &
-   vacancyflux_cahnhilliard_getDiffusion33/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
- 
-end function vacancyflux_cahnhilliard_getDiffusion33
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized vacancy formation energy
-!--------------------------------------------------------------------------------------------------
-real(pReal) function vacancyflux_cahnhilliard_getFormationEnergy(ip,el)
- use lattice, only: &
-   lattice_vacancyFormationEnergy, &
-   lattice_vacancyVol, &
-   lattice_vacancySurfaceEnergy
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase
- use mesh, only: &
-   mesh_element
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- integer(pInt) :: &
-   grain
-  
- vacancyflux_cahnhilliard_getFormationEnergy = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mesh_element(3,el))
-   vacancyflux_cahnhilliard_getFormationEnergy = vacancyflux_cahnhilliard_getFormationEnergy + &
-    lattice_vacancyFormationEnergy(material_phase(grain,ip,el))/ &
-    lattice_vacancyVol(material_phase(grain,ip,el))/ &
-    lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
- enddo
-
- vacancyflux_cahnhilliard_getFormationEnergy = &
-   vacancyflux_cahnhilliard_getFormationEnergy/real(homogenization_Ngrains(mesh_element(3,el)),pReal)
- 
-end function vacancyflux_cahnhilliard_getFormationEnergy
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized vacancy entropy coefficient
-!--------------------------------------------------------------------------------------------------
-real(pReal) function vacancyflux_cahnhilliard_getEntropicCoeff(ip,el)
- use lattice, only: &
-   lattice_vacancyVol, &
-   lattice_vacancySurfaceEnergy
- use material, only: &
-   homogenization_Ngrains, &
-   material_homog, &
-   material_phase, &
-   temperature, &
-   thermalMapping
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- integer(pInt) :: &
-   grain
-  
- vacancyflux_cahnhilliard_getEntropicCoeff = 0.0_pReal
- do grain = 1, homogenization_Ngrains(material_homog(ip,el))
-   vacancyflux_cahnhilliard_getEntropicCoeff = vacancyflux_cahnhilliard_getEntropicCoeff + &
-    kB/ &
-    lattice_vacancyVol(material_phase(grain,ip,el))/ &
-    lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
- enddo
-
- vacancyflux_cahnhilliard_getEntropicCoeff = &
-   vacancyflux_cahnhilliard_getEntropicCoeff* &
-   temperature(material_homog(ip,el))%p(thermalMapping(material_homog(ip,el))%p(ip,el))/ &
-   real(homogenization_Ngrains(material_homog(ip,el)),pReal)
- 
-end function vacancyflux_cahnhilliard_getEntropicCoeff
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized kinematic contribution to chemical potential
-!--------------------------------------------------------------------------------------------------
-subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCv, Cv, ip, el)
- use lattice, only: &
-   lattice_vacancySurfaceEnergy
- use material, only: &
-   homogenization_Ngrains, &
-   material_homog, &
-   phase_kinematics, &
-   phase_Nkinematics, &
-   material_phase, &
-   KINEMATICS_vacancy_strain_ID
- use crystallite, only: &
-   crystallite_Tstar_v, &
-   crystallite_Fi0, &
-   crystallite_Fi
- use kinematics_vacancy_strain, only: &
-   kinematics_vacancy_strain_ChemPotAndItsTangent
-
- implicit none
- integer(pInt), intent(in)  :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in)  :: &
-   Cv
- real(pReal),   intent(out) :: &
-   KPot, dKPot_dCv
- real(pReal) :: &
-   my_KPot, my_dKPot_dCv
- integer(pInt) :: &
-   grain, kinematics
-  
- KPot = 0.0_pReal
- dKPot_dCv = 0.0_pReal
- do grain = 1_pInt,homogenization_Ngrains(material_homog(ip,el)) 
-   do kinematics = 1_pInt, phase_Nkinematics(material_phase(grain,ip,el))
-     select case (phase_kinematics(kinematics,material_phase(grain,ip,el)))
-       case (KINEMATICS_vacancy_strain_ID)
-         call kinematics_vacancy_strain_ChemPotAndItsTangent(my_KPot, my_dKPot_dCv, &
-                                                             crystallite_Tstar_v(1:6,grain,ip,el), &
-                                                             crystallite_Fi0(1:3,1:3,grain,ip,el), &
-                                                             crystallite_Fi (1:3,1:3,grain,ip,el), &
-                                                             grain,ip, el)
-
-       case default
-         my_KPot = 0.0_pReal
-         my_dKPot_dCv = 0.0_pReal
-     
-     end select
-     KPot = KPot + my_KPot/lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
-     dKPot_dCv = dKPot_dCv + my_dKPot_dCv/lattice_vacancySurfaceEnergy(material_phase(grain,ip,el))
-   enddo
- enddo 
- 
- KPot = KPot/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
- dKPot_dCv = dKPot_dCv/real(homogenization_Ngrains(material_homog(ip,el)),pReal)
-
-end subroutine vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized chemical potential and its tangent
-!--------------------------------------------------------------------------------------------------
-subroutine vacancyflux_cahnhilliard_getChemPotAndItsTangent(ChemPot,dChemPot_dCv,Cv,ip,el)
- use numerics, only: &
-   vacancyBoundPenalty, &
-   vacancyPolyOrder
- use material, only: &
-   mappingHomogenization, &
-   vacancyflux_typeInstance, &
-   porosity, &
-   porosityMapping
-
- implicit none
- integer(pInt), intent(in)  :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in)  :: &
-   Cv
- real(pReal),   intent(out) :: &
-   ChemPot, &
-   dChemPot_dCv
- real(pReal) :: &
-   VoidPhaseFrac, kBT, KPot, dKPot_dCv  
- integer(pInt) :: &
-   homog, o  
-  
- homog = mappingHomogenization(2,ip,el)
- VoidPhaseFrac = porosity(homog)%p(porosityMapping(homog)%p(ip,el))
- kBT = vacancyflux_cahnhilliard_getEntropicCoeff(ip,el)
- 
- ChemPot = vacancyflux_cahnhilliard_getFormationEnergy(ip,el)    
- dChemPot_dCv = 0.0_pReal
- do o = 1_pInt, vacancyPolyOrder
-   ChemPot = ChemPot + kBT*((2.0_pReal*Cv - 1.0_pReal)**real(2_pInt*o-1_pInt,pReal))/ &
-                       real(2_pInt*o-1_pInt,pReal)
-   dChemPot_dCv = dChemPot_dCv + 2.0_pReal*kBT*(2.0_pReal*Cv - 1.0_pReal)**real(2_pInt*o-2_pInt,pReal) 
- enddo
- 
- ChemPot =   VoidPhaseFrac*VoidPhaseFrac*ChemPot &
-           - 2.0_pReal*(1.0_pReal - Cv)*(1.0_pReal - VoidPhaseFrac)*(1.0_pReal - VoidPhaseFrac)
-
- dChemPot_dCv =   VoidPhaseFrac*VoidPhaseFrac*dChemPot_dCv &
-                + 2.0_pReal*(1.0_pReal - VoidPhaseFrac)*(1.0_pReal - VoidPhaseFrac)
-
- call vacancyflux_cahnhilliard_KinematicChemPotAndItsTangent(KPot, dKPot_dCv, Cv, ip, el)
- ChemPot = ChemPot + KPot 
- dChemPot_dCv = dChemPot_dCv + dKPot_dCv
- 
- if (Cv < 0.0_pReal) then
-   ChemPot = ChemPot - 3.0_pReal*vacancyBoundPenalty*Cv*Cv
-   dChemPot_dCv = dChemPot_dCv - 6.0_pReal*vacancyBoundPenalty*Cv
- elseif (Cv > 1.0_pReal) then
-   ChemPot = ChemPot + 3.0_pReal*vacancyBoundPenalty*(1.0_pReal - Cv)*(1.0_pReal - Cv)
-   dChemPot_dCv = dChemPot_dCv - 6.0_pReal*vacancyBoundPenalty*(1.0_pReal - Cv)
- endif
- 
- ChemPot = ChemPot* &
-           vacancyflux_cahnhilliard_thermalFluc(vacancyflux_typeInstance(homog))%p(mappingHomogenization(1,ip,el))
- dChemPot_dCv = dChemPot_dCv* &
-           vacancyflux_cahnhilliard_thermalFluc(vacancyflux_typeInstance(homog))%p(mappingHomogenization(1,ip,el))                 
- 
-end subroutine vacancyflux_cahnhilliard_getChemPotAndItsTangent
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief updated vacancy concentration and its rate with solution from transport PDE
-!--------------------------------------------------------------------------------------------------
-subroutine vacancyflux_cahnhilliard_putVacancyConcAndItsRate(Cv,Cvdot,ip,el)
- use material, only: &
-   mappingHomogenization, &
-   vacancyConc, &
-   vacancyConcRate, &
-   vacancyfluxMapping
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in) :: &
-   Cv, &
-   Cvdot
- integer(pInt) :: &
-   homog, &
-   offset  
- 
- homog  = mappingHomogenization(2,ip,el)
- offset = vacancyfluxMapping(homog)%p(ip,el)
- vacancyConc    (homog)%p(offset) = Cv
- vacancyConcRate(homog)%p(offset) = Cvdot
-
-end subroutine vacancyflux_cahnhilliard_putVacancyConcAndItsRate
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief return array of vacancy transport results
-!--------------------------------------------------------------------------------------------------
-function vacancyflux_cahnhilliard_postResults(ip,el)
- use material, only: &
-   mappingHomogenization, &
-   vacancyflux_typeInstance, &
-   vacancyConc, &
-   vacancyfluxMapping
-
- implicit none
- integer(pInt),              intent(in) :: &
-   ip, &                                                                                            !< integration point
-   el                                                                                               !< element
- real(pReal), dimension(vacancyflux_cahnhilliard_sizePostResults(vacancyflux_typeInstance(mappingHomogenization(2,ip,el)))) :: &
-   vacancyflux_cahnhilliard_postResults
-
- integer(pInt) :: &
-   instance, homog, offset, o, c
-   
- homog     = mappingHomogenization(2,ip,el)
- offset    = vacancyfluxMapping(homog)%p(ip,el)
- instance  = vacancyflux_typeInstance(homog)
-
- c = 0_pInt
- vacancyflux_cahnhilliard_postResults = 0.0_pReal
-
- do o = 1_pInt,vacancyflux_cahnhilliard_Noutput(instance)
-    select case(vacancyflux_cahnhilliard_outputID(o,instance))
- 
-      case (vacancyConc_ID)
-        vacancyflux_cahnhilliard_postResults(c+1_pInt) = vacancyConc(homog)%p(offset)
-        c = c + 1
-    end select
- enddo
-end function vacancyflux_cahnhilliard_postResults
-
-end module vacancyflux_cahnhilliard

src/vacancyflux_isochempot.f90

@@ -1,328 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for locally evolving vacancy concentration
-!> @details to be done
-!--------------------------------------------------------------------------------------------------
-module vacancyflux_isochempot
- use prec, only: &
-   pReal, &
-   pInt
-
- implicit none
- private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   vacancyflux_isochempot_sizePostResults                                                           !< cumulative size of post results
-
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
-   vacancyflux_isochempot_sizePostResult                                                            !< size of each post result output
-
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
-   vacancyflux_isochempot_output                                                                    !< name of each post result output
-   
- integer(pInt),                       dimension(:),           allocatable, target, public :: &
-   vacancyflux_isochempot_Noutput                                                                   !< number of outputs per instance of this damage 
-
- enum, bind(c) 
-   enumerator :: undefined_ID, &
-                 vacancyconc_ID
- end enum
- integer(kind(undefined_ID)),         dimension(:,:),         allocatable,          private :: & 
-   vacancyflux_isochempot_outputID                                                                  !< ID of each post result output
-
-
- public :: &
-   vacancyflux_isochempot_init, &
-   vacancyflux_isochempot_updateState, &
-   vacancyflux_isochempot_getSourceAndItsTangent, &
-   vacancyflux_isochempot_postResults 
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine vacancyflux_isochempot_init(fileUnit)
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use IO, only: &
-   IO_read, &
-   IO_lc, &
-   IO_getTag, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_warning, &
-   IO_error, &
-   IO_timeStamp, &
-   IO_EOF
- use material, only: &
-   vacancyflux_type, &
-   vacancyflux_typeInstance, &
-   homogenization_Noutput, &
-   VACANCYFLUX_isochempot_label, &
-   VACANCYFLUX_isochempot_ID, &
-   material_homog, &  
-   mappingHomogenization, &
-   vacancyfluxState, &
-   vacancyfluxMapping, &
-   vacancyConc, &
-   vacancyConcRate, &
-   vacancyflux_initialCv
- use config, only: &
-   material_partHomogenization
-
- implicit none
- integer(pInt), intent(in) :: fileUnit
-
- integer(pInt), allocatable, dimension(:) :: chunkPos
- integer(pInt) :: maxNinstance,mySize=0_pInt,section,instance,o
- integer(pInt) :: sizeState
- integer(pInt) :: NofMyHomog   
- character(len=65536) :: &
-   tag  = '', &
-   line = ''
-
- write(6,'(/,a)')   ' <<<+-  vacancyflux_'//VACANCYFLUX_isochempot_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
- 
- maxNinstance = int(count(vacancyflux_type == VACANCYFLUX_isochempot_ID),pInt)
- if (maxNinstance == 0_pInt) return
- 
- allocate(vacancyflux_isochempot_sizePostResults(maxNinstance),                               source=0_pInt)
- allocate(vacancyflux_isochempot_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
- allocate(vacancyflux_isochempot_output         (maxval(homogenization_Noutput),maxNinstance))
-          vacancyflux_isochempot_output = ''
- allocate(vacancyflux_isochempot_outputID       (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
- allocate(vacancyflux_isochempot_Noutput        (maxNinstance),                               source=0_pInt) 
-
- rewind(fileUnit)
- section = 0_pInt
- do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partHomogenization)! wind forward to <homogenization>
-   line = IO_read(fileUnit)
- enddo
- 
- parsingFile: do while (trim(line) /= IO_EOF)                                                       ! read through sections of homog 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 homog section
-     section = section + 1_pInt                                                                     ! advance homog section counter
-     cycle                                                                                          ! skip to next line
-   endif
-
-   if (section > 0_pInt ) then; if (vacancyflux_type(section) == VACANCYFLUX_isochempot_ID) then             ! do not short-circuit here (.and. with next if statemen). It's not safe in Fortran
-
-     instance = vacancyflux_typeInstance(section)                                                       ! which instance of my vacancyflux is present homog
-     chunkPos = IO_stringPos(line)
-     tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                             ! extract key
-     select case(tag)
-       case ('(output)')
-         select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))
-           case ('vacancyconc')
-             vacancyflux_isochempot_Noutput(instance) = vacancyflux_isochempot_Noutput(instance) + 1_pInt
-             vacancyflux_isochempot_outputID(vacancyflux_isochempot_Noutput(instance),instance) = vacancyconc_ID
-             vacancyflux_isochempot_output(vacancyflux_isochempot_Noutput(instance),instance) = &
-                                                       IO_lc(IO_stringValue(line,chunkPos,2_pInt))
-          end select
-
-     end select
-   endif; endif
- enddo parsingFile
- 
- initializeInstances: do section = 1_pInt, size(vacancyflux_type)
-   if (vacancyflux_type(section) == VACANCYFLUX_isochempot_ID) then
-     NofMyHomog=count(material_homog==section)
-     instance = vacancyflux_typeInstance(section)
-
-!--------------------------------------------------------------------------------------------------
-!  Determine size of postResults array
-     outputsLoop: do o = 1_pInt,vacancyflux_isochempot_Noutput(instance)
-       select case(vacancyflux_isochempot_outputID(o,instance))
-         case(vacancyconc_ID)
-           mySize = 1_pInt
-       end select
- 
-       if (mySize > 0_pInt) then  ! any meaningful output found
-          vacancyflux_isochempot_sizePostResult(o,instance) = mySize
-          vacancyflux_isochempot_sizePostResults(instance)  = vacancyflux_isochempot_sizePostResults(instance) + mySize
-       endif
-     enddo outputsLoop
-
-! allocate state arrays
-     sizeState = 1_pInt
-     vacancyfluxState(section)%sizeState = sizeState
-     vacancyfluxState(section)%sizePostResults = vacancyflux_isochempot_sizePostResults(instance)
-     allocate(vacancyfluxState(section)%state0   (sizeState,NofMyHomog), source=vacancyflux_initialCv(section))
-     allocate(vacancyfluxState(section)%subState0(sizeState,NofMyHomog), source=vacancyflux_initialCv(section))
-     allocate(vacancyfluxState(section)%state    (sizeState,NofMyHomog), source=vacancyflux_initialCv(section))
-
-     nullify(vacancyfluxMapping(section)%p)
-     vacancyfluxMapping(section)%p => mappingHomogenization(1,:,:)
-     deallocate(vacancyConc(section)%p)
-     vacancyConc(section)%p => vacancyfluxState(section)%state(1,:)
-     deallocate(vacancyConcRate(section)%p)
-     allocate(vacancyConcRate(section)%p(NofMyHomog), source=0.0_pReal)
-     
-   endif
- 
- enddo initializeInstances
-end subroutine vacancyflux_isochempot_init
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  calculates change in vacancy concentration based on local vacancy generation model  
-!--------------------------------------------------------------------------------------------------
-function vacancyflux_isochempot_updateState(subdt, ip, el)
- use numerics, only: &
-   err_vacancyflux_tolAbs, &
-   err_vacancyflux_tolRel
- use material, only: &
-   mappingHomogenization, &
-   vacancyflux_typeInstance, &
-   vacancyfluxState, &
-   vacancyConc, &
-   vacancyConcRate, &
-   vacancyfluxMapping
-
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in) :: &
-   subdt
- logical,                    dimension(2)                             :: &
-   vacancyflux_isochempot_updateState
- integer(pInt) :: &
-   homog, &
-   offset, &
-   instance
- real(pReal) :: &
-   Cv, Cvdot, dCvDot_dCv  
-
- homog  = mappingHomogenization(2,ip,el)
- offset = mappingHomogenization(1,ip,el)
- instance = vacancyflux_typeInstance(homog)
- 
- Cv = vacancyfluxState(homog)%subState0(1,offset)
- call vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el)
- Cv = Cv + subdt*Cvdot 
- 
- vacancyflux_isochempot_updateState = [     abs(Cv - vacancyfluxState(homog)%state(1,offset)) &
-                                         <= err_vacancyflux_tolAbs &
-                                       .or. abs(Cv - vacancyfluxState(homog)%state(1,offset)) &
-                                         <= err_vacancyflux_tolRel*abs(vacancyfluxState(homog)%state(1,offset)), &
-                                      .true.]
-
- vacancyConc    (homog)%p(vacancyfluxMapping(homog)%p(ip,el)) = Cv
- vacancyConcRate(homog)%p(vacancyfluxMapping(homog)%p(ip,el)) = &
-   (vacancyfluxState(homog)%state(1,offset) - vacancyfluxState(homog)%subState0(1,offset))/(subdt+tiny(0.0_pReal))
- 
-end function vacancyflux_isochempot_updateState
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  calculates homogenized vacancy driving forces  
-!--------------------------------------------------------------------------------------------------
-subroutine vacancyflux_isochempot_getSourceAndItsTangent(CvDot, dCvDot_dCv, Cv, ip, el)
- use material, only: &
-   homogenization_Ngrains, &
-   mappingHomogenization, &
-   phaseAt, &
-   phase_source, &
-   phase_Nsources, &
-   SOURCE_vacancy_phenoplasticity_ID, &
-   SOURCE_vacancy_irradiation_ID, &
-   SOURCE_vacancy_thermalfluc_ID
- use source_vacancy_phenoplasticity, only: &
-   source_vacancy_phenoplasticity_getRateAndItsTangent
- use source_vacancy_irradiation, only: &
-   source_vacancy_irradiation_getRateAndItsTangent
- use source_vacancy_thermalfluc, only: &
-   source_vacancy_thermalfluc_getRateAndItsTangent
- 
- implicit none
- integer(pInt), intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
- real(pReal),   intent(in) :: &
-   Cv
- integer(pInt) :: &
-   phase, &
-   grain, &
-   source
- real(pReal) :: &
-   CvDot, dCvDot_dCv, localCvDot, dLocalCvDot_dCv  
-
- CvDot = 0.0_pReal
- dCvDot_dCv = 0.0_pReal
- do grain = 1, homogenization_Ngrains(mappingHomogenization(2,ip,el))
-   phase = phaseAt(grain,ip,el)
-   do source = 1_pInt, phase_Nsources(phase)
-     select case(phase_source(source,phase))                                                   
-       case (SOURCE_vacancy_phenoplasticity_ID)
-        call source_vacancy_phenoplasticity_getRateAndItsTangent  (localCvDot, dLocalCvDot_dCv, grain, ip,  el)
-
-       case (SOURCE_vacancy_irradiation_ID)
-        call source_vacancy_irradiation_getRateAndItsTangent  (localCvDot, dLocalCvDot_dCv, grain, ip,  el)
-
-       case (SOURCE_vacancy_thermalfluc_ID)
-        call source_vacancy_thermalfluc_getRateAndItsTangent(localCvDot, dLocalCvDot_dCv, grain, ip,  el)
-
-     end select
-     CvDot = CvDot + localCvDot
-     dCvDot_dCv = dCvDot_dCv + dLocalCvDot_dCv
-   enddo  
- enddo
- 
- CvDot = CvDot/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
- dCvDot_dCv = dCvDot_dCv/real(homogenization_Ngrains(mappingHomogenization(2,ip,el)),pReal)
- 
-end subroutine vacancyflux_isochempot_getSourceAndItsTangent
-
-!--------------------------------------------------------------------------------------------------
-!> @brief return array of vacancy transport results
-!--------------------------------------------------------------------------------------------------
-function vacancyflux_isochempot_postResults(ip,el)
- use material, only: &
-   mappingHomogenization, &
-   vacancyflux_typeInstance, &
-   vacancyConc, &
-   vacancyfluxMapping
-
- implicit none
- integer(pInt),              intent(in) :: &
-   ip, &                                                                                            !< integration point
-   el                                                                                               !< element
- real(pReal), dimension(vacancyflux_isochempot_sizePostResults(vacancyflux_typeInstance(mappingHomogenization(2,ip,el)))) :: &
-   vacancyflux_isochempot_postResults
-
- integer(pInt) :: &
-   instance, homog, offset, o, c
-   
- homog     = mappingHomogenization(2,ip,el)
- offset    = vacancyfluxMapping(homog)%p(ip,el)
- instance  = vacancyflux_typeInstance(homog)
-
- c = 0_pInt
- vacancyflux_isochempot_postResults = 0.0_pReal
-
- do o = 1_pInt,vacancyflux_isochempot_Noutput(instance)
-    select case(vacancyflux_isochempot_outputID(o,instance))
- 
-      case (vacancyconc_ID)
-        vacancyflux_isochempot_postResults(c+1_pInt) = vacancyConc(homog)%p(offset)
-        c = c + 1
-    end select
- enddo
-end function vacancyflux_isochempot_postResults
-
-end module vacancyflux_isochempot

src/vacancyflux_isoconc.f90

@@ -1,62 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for constant vacancy concentration
-!--------------------------------------------------------------------------------------------------
-module vacancyflux_isoconc
-
- implicit none
- private
- 
- public :: &
-   vacancyflux_isoconc_init
-
-contains
-
-!--------------------------------------------------------------------------------------------------
-!> @brief allocates all neccessary fields, reads information from material configuration file
-!--------------------------------------------------------------------------------------------------
-subroutine vacancyflux_isoconc_init()
-#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
- use, intrinsic :: iso_fortran_env, only: &
-   compiler_version, &
-   compiler_options
-#endif
- use prec, only: &
-   pReal, &
-   pInt 
- use IO, only: &
-   IO_timeStamp
- use material
- use config
- 
- implicit none
- integer(pInt) :: &
-   homog, &
-   NofMyHomog
-
- write(6,'(/,a)')   ' <<<+-  vacancyflux_'//VACANCYFLUX_isoconc_label//' init  -+>>>'
- write(6,'(a15,a)') ' Current time: ',IO_timeStamp()
-#include "compilation_info.f90"
-
- initializeInstances: do homog = 1_pInt, material_Nhomogenization
-   
-   myhomog: if (vacancyflux_type(homog) == VACANCYFLUX_isoconc_ID) then
-     NofMyHomog = count(material_homog == homog)
-     vacancyfluxState(homog)%sizeState = 0_pInt
-     vacancyfluxState(homog)%sizePostResults = 0_pInt
-     allocate(vacancyfluxState(homog)%state0   (0_pInt,NofMyHomog))
-     allocate(vacancyfluxState(homog)%subState0(0_pInt,NofMyHomog))
-     allocate(vacancyfluxState(homog)%state    (0_pInt,NofMyHomog))
-     
-     deallocate(vacancyConc    (homog)%p)
-     allocate  (vacancyConc    (homog)%p(1), source=vacancyflux_initialCv(homog))
-     deallocate(vacancyConcRate(homog)%p)
-     allocate  (vacancyConcRate(homog)%p(1), source=0.0_pReal)
-
-   endif myhomog
- enddo initializeInstances
-
-
-end subroutine vacancyflux_isoconc_init
-
-end module vacancyflux_isoconc