Merge remote-tracking branch 'origin/development' into signal_input_handling_1

.gitlab-ci.yml

@@ -262,20 +262,6 @@ Pytest_grid:
     - master
     - release
 
-Thermal:
-  stage: grid
-  script: Thermal/test.py
-  except:
-    - master
-    - release
-
-Nonlocal_Damage_DetectChanges:
-  stage: grid
-  script: Nonlocal_Damage_DetectChanges/test.py
-  except:
-    - master
-    - release
-
 Plasticity_DetectChanges:
   stage: grid
   script: Plasticity_DetectChanges/test.py

.gitmodules

@@ -1,4 +1,5 @@
 [submodule "PRIVATE"]
-	path = PRIVATE
+  path = PRIVATE
   url = ../PRIVATE.git
   branch = master
+  shallow = true

CMakeLists.txt

@@ -1,6 +1,18 @@
-########################################################################################
+cmake_minimum_required (VERSION 3.10.0)
-# Compiler options for building DAMASK
+include (FindPkgConfig REQUIRED)
-cmake_minimum_required (VERSION 3.10.0 FATAL_ERROR)
+
+# Dummy project to determine compiler names and version
+project (Prerequisites LANGUAGES)
+set(ENV{PKG_CONFIG_PATH} "$ENV{PETSC_DIR}/$ENV{PETSC_ARCH}/lib/pkgconfig")
+pkg_check_modules (PETSC REQUIRED PETSc>=3.12.0 PETSc<3.15.0)
+pkg_get_variable (CMAKE_Fortran_COMPILER PETSc fcompiler)
+pkg_get_variable (CMAKE_C_COMPILER PETSc ccompiler)
+
+find_program (CAT_EXECUTABLE NAMES cat)
+execute_process (COMMAND ${CAT_EXECUTABLE} ${PROJECT_SOURCE_DIR}/VERSION
+                 RESULT_VARIABLE DAMASK_VERSION_RETURN
+                 OUTPUT_VARIABLE DAMASK_VERSION
+                 OUTPUT_STRIP_TRAILING_WHITESPACE)
 
 #---------------------------------------------------------------------------------------
 # Find PETSc from system environment
@@ -28,19 +40,10 @@ include ${petsc_conf_rules}
 include ${petsc_conf_variables}
 INCLUDE_DIRS   := \${PETSC_FC_INCLUDES}
 LIBRARIES      := \${PETSC_WITH_EXTERNAL_LIB}
-COMPILERF      := \${FC}
-COMPILERC      := \${CC}
-LINKERNAME     := \${FLINKER}
 includes:
 \t@echo \${INCLUDE_DIRS}
 extlibs:
 \t@echo \${LIBRARIES}
-compilerf:
-\t@echo \${COMPILERF}
-compilerc:
-\t@echo \${COMPILERC}
-linker:
-\t@echo \${LINKERNAME}
 ")
 
 # CMake will execute each target in the ${petsc_config_makefile}
@@ -52,26 +55,10 @@ execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_conf
                  OUTPUT_VARIABLE petsc_includes
                  OUTPUT_STRIP_TRAILING_WHITESPACE)
 # Find the PETSc external linking directory settings
-# required for final linking, must be appended after the executable
 execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "extlibs"
                  RESULT_VARIABLE PETSC_EXTERNAL_LIB_RETURN
                  OUTPUT_VARIABLE petsc_external_lib
                  OUTPUT_STRIP_TRAILING_WHITESPACE)
-# PETSc specified fortran compiler
-execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "compilerf"
-                 RESULT_VARIABLE PETSC_MPIFC_RETURN
-                 OUTPUT_VARIABLE PETSC_MPIFC
-                 OUTPUT_STRIP_TRAILING_WHITESPACE)
-# PETSc specified C compiler
-execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "compilerc"
-                 RESULT_VARIABLE PETSC_MPICC_RETURN
-                 OUTPUT_VARIABLE PETSC_MPICC
-                 OUTPUT_STRIP_TRAILING_WHITESPACE)
-# PETSc specified linker (Fortran compiler + PETSc linking flags)
-execute_process (COMMAND ${MAKE_EXECUTABLE} --no-print-directory -f ${petsc_config_makefile} "linker"
-                 RESULT_VARIABLE PETSC_LINKER_RETURN
-                 OUTPUT_VARIABLE PETSC_LINKER
-                 OUTPUT_STRIP_TRAILING_WHITESPACE)
 # Remove temporary makefile, no need to keep it anymore.
 file (REMOVE_RECURSE ${TEMPDIR})
 
@@ -90,14 +77,6 @@ endforeach (exlib)
 message ("Found PETSC_DIR:\n${PETSC_DIR}\n"                  )
 message ("Found PETSC_INCLUDES:\n${PETSC_INCLUDES}\n"        )
 message ("Found PETSC_EXTERNAL_LIB:\n${PETSC_EXTERNAL_LIB}\n")
-message ("Found PETSC_LINKER:\n${PETSC_LINKER}\n"            )
-message ("Found MPI Fortran Compiler:\n${PETSC_MPIFC}\n"     )
-message ("Found MPI C Compiler:\n${PETSC_MPICC}\n"           )
-
-# set compiler commands to match PETSc (needs to be done before defining the project)
-# https://cmake.org/Wiki/CMake_FAQ#How_do_I_use_a_different_compiler.3F
-set (CMAKE_Fortran_COMPILER "${PETSC_MPIFC}")
-set (CMAKE_C_COMPILER       "${PETSC_MPICC}")
 
 #---------------------------------------------------------------------------------------
 # Now start to care about DAMASK
@@ -105,17 +84,18 @@ set (CMAKE_C_COMPILER       "${PETSC_MPICC}")
 # DAMASK solver defines project to build
 string(TOLOWER ${DAMASK_SOLVER} DAMASK_SOLVER)
 if (DAMASK_SOLVER STREQUAL "grid")
-    project (damask-grid Fortran C)
+    project (damask-grid HOMEPAGE_URL https://damask.mpie.de LANGUAGES Fortran C)
     add_definitions (-DGrid)
-    message ("Building Grid Solver\n")
 elseif (DAMASK_SOLVER STREQUAL "mesh")
-    project (damask-mesh Fortran C)
+    project (damask-mesh HOMEPAGE_URL https://damask.mpie.de LANGUAGES Fortran C)
     add_definitions (-DMesh)
-    message ("Building Mesh Solver\n")
 else ()
     message (FATAL_ERROR "Build target (DAMASK_SOLVER) is not defined")
 endif ()
-list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake)
+add_definitions (-DDAMASKVERSION="${DAMASK_VERSION}")
+add_definitions (-DPETSc)
+
+message ("\nBuilding ${CMAKE_PROJECT_NAME}\n")
 
 if (CMAKE_BUILD_TYPE STREQUAL "")
     set (CMAKE_BUILD_TYPE "RELEASE")
@@ -153,17 +133,8 @@ if (CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY")
     set (BUILDCMD_POST "${BUILDCMD_POST} -fsyntax-only")
 endif ()
 
-# Parse DAMASK version from VERSION file
-find_program (CAT_EXECUTABLE NAMES cat)
-execute_process (COMMAND ${CAT_EXECUTABLE} ${PROJECT_SOURCE_DIR}/VERSION
-                 RESULT_VARIABLE DAMASK_VERSION_RETURN
-                 OUTPUT_VARIABLE DAMASK_V
-                 OUTPUT_STRIP_TRAILING_WHITESPACE)
-add_definitions (-DDAMASKVERSION="${DAMASK_V}")
-
-# definition of other macros
-add_definitions (-DPETSc)
 
+list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake)
 if    (CMAKE_Fortran_COMPILER_ID STREQUAL "Intel")
     include (Compiler-Intel)
 elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
@@ -174,9 +145,8 @@ else ()
     message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized")
 endif ()
 
-
 set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${BUILDCMD_PRE} ${OPENMP_FLAGS} ${STANDARD_CHECK} ${OPTIMIZATION_FLAGS} ${COMPILE_FLAGS} ${PRECISION_FLAGS}")
-set (CMAKE_Fortran_LINK_EXECUTABLE           "${BUILDCMD_PRE} ${PETSC_LINKER} ${OPENMP_FLAGS}   ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}")
+set (CMAKE_Fortran_LINK_EXECUTABLE           "${BUILDCMD_PRE} ${CMAKE_Fortran_COMPILER} ${OPENMP_FLAGS} ${OPTIMIZATION_FLAGS} ${LINKER_FLAGS}")
 
 if (CMAKE_BUILD_TYPE STREQUAL "DEBUG")
     set (CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${DEBUG_FLAGS}")

LICENSE

@@ -1,4 +1,4 @@
-Copyright 2011-20 Max-Planck-Institut für Eisenforschung GmbH
+Copyright 2011-21 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

PRIVATE

@@ -1 +1 @@
-Subproject commit 08f8aea465a1b5e476b584bcae7927d113919b1d
+Subproject commit b1a31a79cc90d458494068a96cfd3e9497aa330c

VERSION

@@ -1 +1 @@
-v3.0.0-alpha2-26-gaad123f41
+v3.0.0-alpha2-292-g589178668

cmake/Compiler-Intel.cmake

@@ -20,7 +20,7 @@ endif ()
 
 # -assume std_mod_proc_name (included in -standard-semantics) causes problems if other modules
 # (PETSc, HDF5) are not compiled with this option (https://software.intel.com/en-us/forums/intel-fortran-compiler-for-linux-and-mac-os-x/topic/62172)
-set (STANDARD_CHECK "-stand f15 -standard-semantics -assume nostd_mod_proc_name")
+set (STANDARD_CHECK "-stand f18 -standard-semantics -assume nostd_mod_proc_name")
 set (LINKER_FLAGS   "${LINKER_FLAGS} -shared-intel")
 # Link against shared Intel libraries instead of static ones
 

examples/FEM/polyXtal/material.yaml

@@ -5,8 +5,8 @@ homogenization:
 
 phase:
   Aluminum:
+    lattice: cF
     mechanics:
-      lattice: cF
       output: [F, P, F_e, F_p, L_p]
       elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke}
       plasticity:

python/damask/_config.py

@@ -1,3 +1,4 @@
+import copy
 from io import StringIO
 import abc
 
@@ -21,6 +22,9 @@ class NiceDumper(yaml.SafeDumper):
         return self.represent_data(dict(data)) if isinstance(data, dict) and type(data) != dict else \
                super().represent_data(data)
 
+    def ignore_aliases(self, data):
+        """No references."""
+        return True
 
 class Config(dict):
     """YAML-based configuration."""
@@ -32,6 +36,14 @@ class Config(dict):
         output.seek(0)
         return ''.join(output.readlines())
 
+
+    def __copy__(self):
+        """Create deep copy."""
+        return copy.deepcopy(self)
+
+    copy = __copy__
+
+
     @classmethod
     def load(cls,fname):
         """
@@ -49,6 +61,7 @@ class Config(dict):
             fhandle = fname
         return cls(yaml.safe_load(fhandle))
 
+
     def save(self,fname,**kwargs):
         """
         Save to yaml file.
@@ -86,12 +99,37 @@ class Config(dict):
             fhandle.write(yaml.dump(self,Dumper=NiceDumper,**kwargs))
 
 
+    def add(self,d):
+        """
+        Add dictionary.
+
+        d : dict
+            Dictionary to append.
+        """
+        duplicate = self.copy()
+        duplicate.update(d)
+        return duplicate
+
+
+    def delete(self,key):
+        """
+        Delete item.
+
+        key : str or scalar
+            Label of the key to remove.
+        """
+        duplicate = self.copy()
+        del duplicate[key]
+        return duplicate
+
+
     @property
     @abc.abstractmethod
     def is_complete(self):
         """Check for completeness."""
         pass
 
+
     @property
     @abc.abstractmethod
     def is_valid(self):

python/damask/_configmaterial.py

@@ -1,5 +1,3 @@
-import copy
-
 import numpy as np
 
 from . import Config
@@ -9,6 +7,15 @@ from . import Orientation
 class ConfigMaterial(Config):
     """Material configuration."""
 
+    _defaults = {'material': [],
+                 'homogenization': {},
+                 'phase': {}}
+
+    def __init__(self,d=_defaults):
+        """Initialize object with default dictionary keys."""
+        super().__init__(d)
+
+
     def save(self,fname='material.yaml',**kwargs):
         """
         Save to yaml file.
@@ -75,6 +82,8 @@ class ConfigMaterial(Config):
                 fraction: 1.0
                 phase: Steel
             homogenization: SX
+        homogenization: {}
+        phase: {}
 
         """
         constituents_ = {k:table.get(v) for k,v in constituents.items()}
@@ -192,7 +201,7 @@ class ConfigMaterial(Config):
             Limit renaming to selected constituents.
 
         """
-        dup = copy.deepcopy(self)
+        dup = self.copy()
         for i,m in enumerate(dup['material']):
             if ID and i not in ID: continue
             for c in m['constituents']:
@@ -216,7 +225,7 @@ class ConfigMaterial(Config):
             Limit renaming to selected homogenization IDs.
 
         """
-        dup = copy.deepcopy(self)
+        dup = self.copy()
         for i,m in enumerate(dup['material']):
             if ID and i not in ID: continue
             try:
@@ -261,6 +270,8 @@ class ConfigMaterial(Config):
                 fraction: 1.0
                 phase: Aluminum
             homogenization: SX
+        homogenization: {}
+        phase: {}
 
         """
         length = -1
@@ -274,7 +285,8 @@ class ConfigMaterial(Config):
 
         c = [{} for _ in range(length)] if constituents is None else \
             [{'constituents':u} for u in ConfigMaterial._constituents(**constituents)]
-        if len(c) == 1: c = [copy.deepcopy(c[0]) for _ in range(length)]
+
+        if len(c) == 1: c = [c[0] for _ in range(length)]
 
         if length != 1 and length != len(c):
             raise ValueError('Cannot add entries of different length')
@@ -286,7 +298,7 @@ class ConfigMaterial(Config):
             else:
                 for i in range(len(c)):
                     c[i][k] = v
-        dup = copy.deepcopy(self)
+        dup = self.copy()
         dup['material'] = dup['material'] + c if 'material' in dup else c
 
         return dup

python/damask/_grid.py

@@ -57,13 +57,10 @@ class Grid:
 
 
     def __copy__(self):
-        """Copy grid."""
+        """Create deep copy."""
         return copy.deepcopy(self)
 
-
+    copy = __copy__
-    def copy(self):
-        """Copy grid."""
-        return self.__copy__()
 
 
     def diff(self,other):
@@ -766,24 +763,19 @@ class Grid:
         if fill is None: fill = np.nanmax(self.material) + 1
         dtype = float if np.isnan(fill) or int(fill) != fill or self.material.dtype==np.float else int
 
-        Eulers = R.as_Euler_angles(degrees=True)
+        material = self.material
-        material_in = self.material.copy()
-
         # These rotations are always applied in the reference coordinate system, i.e. (z,x,z) not (z,x',z'')
         # see https://www.cs.utexas.edu/~theshark/courses/cs354/lectures/cs354-14.pdf
-        for angle,axes in zip(Eulers[::-1], [(0,1),(1,2),(0,1)]):
+        for angle,axes in zip(R.as_Euler_angles(degrees=True)[::-1], [(0,1),(1,2),(0,1)]):
-            material_out = ndimage.rotate(material_in,angle,axes,order=0,
+            material_temp = ndimage.rotate(material,angle,axes,order=0,prefilter=False,output=dtype,cval=fill)
-                                                prefilter=False,output=dtype,cval=fill)
+            # avoid scipy interpolation errors for rotations close to multiples of 90°
-            if np.prod(material_in.shape) == np.prod(material_out.shape):
+            material = material_temp if np.prod(material_temp.shape) != np.prod(material.shape) else \
-                # avoid scipy interpolation errors for rotations close to multiples of 90°
+                       np.rot90(material,k=np.rint(angle/90.).astype(int),axes=axes)
-                material_in = np.rot90(material_in,k=np.rint(angle/90.).astype(int),axes=axes)
-            else:
-                material_in = material_out
 
-        origin = self.origin-(np.asarray(material_in.shape)-self.cells)*.5 * self.size/self.cells
+        origin = self.origin-(np.asarray(material.shape)-self.cells)*.5 * self.size/self.cells
 
-        return Grid(material = material_in,
+        return Grid(material = material,
-                    size     = self.size/self.cells*np.asarray(material_in.shape),
+                    size     = self.size/self.cells*np.asarray(material.shape),
                     origin   = origin,
                     comments = self.comments+[util.execution_stamp('Grid','rotate')],
                    )

python/damask/_orientation.py

@@ -199,7 +199,7 @@ class Orientation(Rotation):
 
 
     def __copy__(self,**kwargs):
-        """Copy."""
+        """Create deep copy."""
         return self.__class__(rotation=kwargs['rotation'] if 'rotation' in kwargs else self.quaternion,
                               lattice =kwargs['lattice']  if 'lattice'  in kwargs else self.lattice
                                                                                     if self.lattice is not None else self.family,
@@ -225,30 +225,42 @@ class Orientation(Rotation):
             Orientation to check for equality.
 
         """
-        return  super().__eq__(other) \
+        matching_type = all([hasattr(other,attr) and getattr(self,attr) == getattr(other,attr)
-            and self.family     == other.family \
+                             for attr in ['family','lattice','parameters']])
-            and self.lattice    == other.lattice \
+        return np.logical_and(super().__eq__(other),matching_type)
-            and self.parameters == other.parameters
 
-
+    def __ne__(self,other):
-    def __matmul__(self,other):
         """
-        Rotation of vector, second or fourth order tensor, or rotation object.
+        Not equal to other.
 
         Parameters
         ----------
-        other : numpy.ndarray, Rotation, or Orientation
+        other : Orientation
-            Vector, second or fourth order tensor, or rotation object that is rotated.
+            Orientation to check for equality.
+
+        """
+        return np.logical_not(self==other)
+
+
+    def __mul__(self,other):
+        """
+        Compose this orientation with other.
+
+        Parameters
+        ----------
+        other : Rotation or Orientation
+            Object for composition.
 
         Returns
         -------
-        other_rot : numpy.ndarray or Rotation
+        composition : Orientation
-            Rotated vector, second or fourth order tensor, or rotation object.
+            Compound rotation self*other, i.e. first other then self rotation.
 
         """
-        return self.copy(rotation=Rotation.__matmul__(self,Rotation(other.quaternion))) \
+        if isinstance(other,Orientation) or isinstance(other,Rotation):
-               if isinstance(other,self.__class__) else \
+            return self.copy(rotation=Rotation.__mul__(self,Rotation(other.quaternion)))
-               Rotation.__matmul__(self,other)
+        else:
+            raise TypeError('Use "O@b", i.e. matmul, to apply Orientation "O" to object "b"')
 
 
     @classmethod
@@ -429,7 +441,7 @@ class Orientation(Rotation):
             raise ValueError('Missing crystal symmetry')
 
         o = self.symmetry_operations.broadcast_to(self.symmetry_operations.shape+self.shape,mode='right')
-        return self.copy(rotation=o@Rotation(self.quaternion).broadcast_to(o.shape,mode='left'))
+        return self.copy(rotation=o*Rotation(self.quaternion).broadcast_to(o.shape,mode='left'))
 
 
     @property
@@ -608,7 +620,7 @@ class Orientation(Rotation):
         o,lattice = self.relation_operations(model,return_lattice=True)
         target = Orientation(lattice=lattice)
         o = o.broadcast_to(o.shape+self.shape,mode='right')
-        return self.copy(rotation=o@Rotation(self.quaternion).broadcast_to(o.shape,mode='left'),
+        return self.copy(rotation=o*Rotation(self.quaternion).broadcast_to(o.shape,mode='left'),
                          lattice=lattice,
                          b = self.b if target.ratio['b'] is None else self.a*target.ratio['b'],
                          c = self.c if target.ratio['c'] is None else self.a*target.ratio['c'],

python/damask/_rotation.py

@@ -35,6 +35,11 @@ class Rotation:
     - b = Q @ a
     - b = np.dot(Q.as_matrix(),a)
 
+    Compound rotations R1 (first) and R2 (second):
+
+    - R = R2 * R1
+    - R = Rotation.from_matrix(np.dot(R2.as_matrix(),R1.as_matrix())
+
     References
     ----------
     D. Rowenhorst et al., Modelling and Simulation in Materials Science and Engineering 23:083501, 2015
@@ -65,22 +70,13 @@ class Rotation:
 
 
     def __repr__(self):
-        """Represent rotation as unit quaternion, rotation matrix, and Bunge-Euler angles."""
+        """Represent rotation as unit quaternion(s)."""
-        if self == Rotation():
+        return f'Quaternion{" " if self.quaternion.shape == (4,) else "s of shape "+str(self.quaternion.shape)+chr(10)}'\
-           return 'Rotation()'
+               + str(self.quaternion)
-        else:
-            return f'Quaternions {self.shape}:\n'+str(self.quaternion) \
-                   if self.quaternion.shape != (4,) else \
-                   '\n'.join([
-                   'Quaternion: (real={:.3f}, imag=<{:+.3f}, {:+.3f}, {:+.3f}>)'.format(*(self.quaternion)),
-                   'Matrix:\n{}'.format(np.round(self.as_matrix(),8)),
-                   'Bunge Eulers / deg: ({:3.2f}, {:3.2f}, {:3.2f})'.format(*self.as_Euler_angles(degrees=True)),
-                    ])
 
 
-    # ToDo: Check difference __copy__ vs __deepcopy__
     def __copy__(self,**kwargs):
-        """Copy."""
+        """Create deep copy."""
         return self.__class__(rotation=kwargs['rotation'] if 'rotation' in kwargs else self.quaternion)
 
     copy = __copy__
@@ -97,6 +93,26 @@ class Rotation:
         """
         Equal to other.
 
+        Equality is determined taking limited floating point precision into account.
+        See numpy.allclose for details.
+
+        Parameters
+        ----------
+        other : Rotation
+            Rotation to check for equality.
+
+        """
+        s = self.quaternion
+        o = other.quaternion
+        if self.shape == () == other.shape:
+            return np.allclose(s,o) or (np.isclose(s[0],0.0) and np.allclose(s,-1.0*o))
+        else:
+            return np.all(np.isclose(s,o),-1) + np.all(np.isclose(s,-1.0*o),-1) * np.isclose(s[...,0],0.0)
+
+    def __ne__(self,other):
+        """
+        Not equal to other.
+
         Equality is determined taking limited floating point precision into
         account. See numpy.allclose for details.
 
@@ -106,8 +122,7 @@ class Rotation:
             Rotation to check for equality.
 
         """
-        return      np.prod(self.shape,dtype=int) == np.prod(other.shape,dtype=int) \
+        return np.logical_not(self==other)
-                and np.allclose(self.quaternion,other.quaternion)
 
 
     @property
@@ -127,36 +142,46 @@ class Rotation:
         return dup
 
 
-    def __pow__(self,pwr):
+    def __pow__(self,exp):
         """
-        Raise quaternion to power.
+        Perform the rotation 'exp' times.
-
-        Equivalent to performing the rotation 'pwr' times.
 
         Parameters
         ----------
-        pwr : float
+        exp : float
-            Power to raise quaternion to.
+            Exponent.
 
         """
         phi = np.arccos(self.quaternion[...,0:1])
         p = self.quaternion[...,1:]/np.linalg.norm(self.quaternion[...,1:],axis=-1,keepdims=True)
-        return self.copy(rotation=Rotation(np.block([np.cos(pwr*phi),np.sin(pwr*phi)*p]))._standardize())
+        return self.copy(rotation=Rotation(np.block([np.cos(exp*phi),np.sin(exp*phi)*p]))._standardize())
 
-
+    def __ipow__(self,exp):
-    def __matmul__(self,other):
         """
-        Rotation of vector, second or fourth order tensor, or rotation object.
+        Perform the rotation 'exp' times (in-place).
 
         Parameters
         ----------
-        other : numpy.ndarray or Rotation
+        exp : float
-            Vector, second or fourth order tensor, or rotation object that is rotated.
+            Exponent.
+
+        """
+        return self**exp
+
+
+    def __mul__(self,other):
+        """
+        Compose this rotation with other.
+
+        Parameters
+        ----------
+        other : Rotation of shape(self.shape)
+            Rotation for composition.
 
         Returns
         -------
-        other_rot : numpy.ndarray or Rotation
+        composition : Rotation
-            Rotated vector, second or fourth order tensor, or rotation object.
+            Compound rotation self*other, i.e. first other then self rotation.
 
         """
         if isinstance(other,Rotation):
@@ -167,8 +192,71 @@ class Rotation:
             q = (q_m*q_o - np.einsum('...i,...i',p_m,p_o).reshape(self.shape+(1,)))
             p = q_m*p_o + q_o*p_m + _P * np.cross(p_m,p_o)
             return Rotation(np.block([q,p]))._standardize()
+        else:
+            raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"')
 
-        elif isinstance(other,np.ndarray):
+    def __imul__(self,other):
+        """
+        Compose this rotation with other (in-place).
+
+        Parameters
+        ----------
+        other : Rotation of shape(self.shape)
+            Rotation for composition.
+
+        """
+        return self*other
+
+
+    def __truediv__(self,other):
+        """
+        Compose this rotation with inverse of other.
+
+        Parameters
+        ----------
+        other : damask.Rotation of shape (self.shape)
+            Rotation to inverse composition.
+
+        Returns
+        -------
+        composition : Rotation
+            Compound rotation self*(~other), i.e. first inverse of other then self rotation.
+
+        """
+        if isinstance(other,Rotation):
+            return self*~other
+        else:
+            raise TypeError('Use "R@b", i.e. matmul, to apply rotation "R" to object "b"')
+
+    def __itruediv__(self,other):
+        """
+        Compose this rotation with inverse of other (in-place).
+
+        Parameters
+        ----------
+        other : Rotation of shape (self.shape)
+            Rotation to inverse composition.
+
+        """
+        return self/other
+
+
+    def __matmul__(self,other):
+        """
+        Rotation of vector, second order tensor, or fourth order tensor.
+
+        Parameters
+        ----------
+        other : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3)
+            Vector or tensor on which to apply the rotation.
+
+        Returns
+        -------
+        rotated : numpy.ndarray of shape (...,3), (...,3,3), or (...,3,3,3,3)
+            Rotated vector or tensor, i.e. transformed to frame defined by rotation.
+
+        """
+        if isinstance(other,np.ndarray):
             if self.shape + (3,) == other.shape:
                 q_m = self.quaternion[...,0]
                 p_m = self.quaternion[...,1:]
@@ -188,9 +276,13 @@ class Rotation:
                 return np.einsum('...im,...jn,...ko,...lp,...mnop',R,R,R,R,other)
             else:
                 raise ValueError('Can only rotate vectors, 2nd order tensors, and 4th order tensors')
+        elif isinstance(other,Rotation):
+            raise TypeError('Use "R1*R2", i.e. multiplication, to compose rotations "R1" and "R2"')
         else:
             raise TypeError(f'Cannot rotate {type(other)}')
 
+    apply = __matmul__
+
 
     def _standardize(self):
         """Standardize quaternion (ensure positive real hemisphere)."""
@@ -199,8 +291,16 @@ class Rotation:
 
 
     def append(self,other):
-        """Extend rotation array along first dimension with other array."""
+        """
-        return self.copy(rotation=np.vstack((self.quaternion,other.quaternion)))
+        Extend rotation array along first dimension with other array(s).
+
+        Parameters
+        ----------
+            other : Rotation or list of Rotations.
+
+        """
+        return self.copy(rotation=np.vstack(tuple(map(lambda x:x.quaternion,
+                                                      [self]+other if isinstance(other,list) else [self,other]))))
 
 
     def flatten(self,order = 'C'):
@@ -258,7 +358,7 @@ class Rotation:
             """Intermediate representation supporting quaternion averaging."""
             return np.einsum('...i,...j',quat,quat)
 
-        if not weights:
+        if weights is None:
             weights = np.ones(self.shape,dtype=float)
 
         eig, vec = np.linalg.eig(np.sum(_M(self.quaternion) * weights[...,np.newaxis,np.newaxis],axis=-3) \
@@ -283,7 +383,7 @@ class Rotation:
             Rotation to which the misorientation is computed.
 
         """
-        return other@~self
+        return other*~self
 
 
     ################################################################################################
@@ -806,7 +906,7 @@ class Rotation:
                              np.sqrt(1-u**2)*np.sin(Theta),
                              u, omega])
 
-        return  Rotation.from_axis_angle(p) @ center
+        return  Rotation.from_axis_angle(p) * center
 
 
     @staticmethod
@@ -857,8 +957,8 @@ class Rotation:
         f[::2,:3] *= -1                                                                             # flip half the rotation axes to negative sense
 
         return R_align.broadcast_to(N) \
-             @ Rotation.from_axis_angle(p,normalize=True) \
+             * Rotation.from_axis_angle(p,normalize=True) \
-             @ Rotation.from_axis_angle(f)
+             * Rotation.from_axis_angle(f)
 
 
 ####################################################################################################
@@ -1047,7 +1147,6 @@ class Rotation:
     @staticmethod
     def _om2ax(om):
         """Rotation matrix to axis angle pair."""
-        #return Rotation._qu2ax(Rotation._om2qu(om)) # HOTFIX
         diag_delta = -_P*np.block([om[...,1,2:3]-om[...,2,1:2],
                                    om[...,2,0:1]-om[...,0,2:3],
                                    om[...,0,1:2]-om[...,1,0:1]

python/damask/_table.py

@@ -42,12 +42,10 @@ class Table:
         return len(self.data)
 
     def __copy__(self):
-        """Copy Table."""
+        """Create deep copy."""
         return copy.deepcopy(self)
 
-    def copy(self):
+    copy = __copy__
-        """Copy Table."""
-        return self.__copy__()
 
 
     def _label_discrete(self):

python/damask/grid_filters.py

@@ -234,7 +234,7 @@ def cellsSizeOrigin_coordinates0_point(coordinates0,ordered=True):
     origin[_np.where(cells==1)] = 0.0
 
     if cells.prod() != len(coordinates0):
-        raise ValueError('Data count {len(coordinates0)} does not match cells {cells}.')
+        raise ValueError(f'Data count {len(coordinates0)} does not match cells {cells}.')
 
     start = origin + delta*.5
     end   = origin - delta*.5 + size
@@ -387,7 +387,7 @@ def cellsSizeOrigin_coordinates0_node(coordinates0,ordered=True):
     origin    = mincorner
 
     if (cells+1).prod() != len(coordinates0):
-        raise ValueError('Data count {len(coordinates0)} does not match cells {cells}.')
+        raise ValueError(f'Data count {len(coordinates0)} does not match cells {cells}.')
 
     atol = _np.max(size)*5e-2
     if not (_np.allclose(coords[0],_np.linspace(mincorner[0],maxcorner[0],cells[0]+1),atol=atol) and \

python/tests/reference/ConfigMaterial/material.yaml

@@ -1,10 +1,10 @@
 homogenization:
   SX:
-    N_constituents: 2
+    N_constituents: 1
-    mech: {type: none}
+    mechanics: {type: none}
   Taylor:
     N_constituents: 2
-    mech: {type: isostrain}
+    mechanics: {type: isostrain}
 
 material:
   - constituents:
@@ -34,11 +34,11 @@ material:
 phase:
   Aluminum:
     lattice: cF
-    mech:
+    mechanics:
       output: [F, P, F_e, F_p, L_p]
       elasticity: {C_11: 106.75e9, C_12: 60.41e9, C_44: 28.34e9, type: hooke}
   Steel:
     lattice: cI
-    mech:
+    mechanics:
       output: [F, P, F_e, F_p, L_p]
       elasticity: {C_11: 233.3e9, C_12: 135.5e9, C_44: 118.0e9, type: hooke}

python/tests/test_Config.py

@@ -22,6 +22,10 @@ class TestConfig:
         with open(tmp_path/'config.yaml') as f:
             assert Config.load(f) == config
 
+    def test_add_remove(self):
+        config = Config()
+        assert config.add({'hello':'world'}).delete('hello') == config
+
     def test_repr(self,tmp_path):
         config = Config()
         config['A'] = 1

python/tests/test_Orientation.py

@@ -25,13 +25,16 @@ class TestOrientation:
     @pytest.mark.parametrize('shape',[None,5,(4,6)])
     def test_equal(self,lattice,shape):
         R = Rotation.from_random(shape)
-        assert Orientation(R,lattice) == Orientation(R,lattice)
+        assert Orientation(R,lattice) == Orientation(R,lattice) if shape is None else \
+              (Orientation(R,lattice) == Orientation(R,lattice)).all()
+
 
     @pytest.mark.parametrize('lattice',Orientation.crystal_families)
     @pytest.mark.parametrize('shape',[None,5,(4,6)])
     def test_unequal(self,lattice,shape):
         R = Rotation.from_random(shape)
-        assert not(Orientation(R,lattice) != Orientation(R,lattice))
+        assert not ( Orientation(R,lattice) != Orientation(R,lattice) if shape is None else \
+                    (Orientation(R,lattice) != Orientation(R,lattice)).any())
 
     @pytest.mark.parametrize('a,b',[
                                     (dict(rotation=[1,0,0,0]),
@@ -403,7 +406,7 @@ class TestOrientation:
     def test_relationship_vectorize(self,set_of_quaternions,lattice,model):
         r = Orientation(rotation=set_of_quaternions[:200].reshape((50,4,4)),lattice=lattice).related(model)
         for i in range(200):
-            assert r.reshape((-1,200))[:,i] == Orientation(set_of_quaternions[i],lattice).related(model)
+            assert (r.reshape((-1,200))[:,i] == Orientation(set_of_quaternions[i],lattice).related(model)).all()
 
     @pytest.mark.parametrize('model',['Bain','KS','GT','GT_prime','NW','Pitsch'])
     @pytest.mark.parametrize('lattice',['cF','cI'])

python/tests/test_Rotation.py

@@ -526,7 +526,7 @@ class TestRotation:
             o = backward(forward(m))
             u = np.array([np.pi*2,np.pi,np.pi*2])
             ok = np.allclose(m,o,atol=atol)
-            ok = ok or np.allclose(np.where(np.isclose(m,u),m-u,m),np.where(np.isclose(o,u),o-u,o),atol=atol)
+            ok |= np.allclose(np.where(np.isclose(m,u),m-u,m),np.where(np.isclose(o,u),o-u,o),atol=atol)
             if np.isclose(m[1],0.0,atol=atol) or np.isclose(m[1],np.pi,atol=atol):
                 sum_phi = np.unwrap([m[0]+m[2],o[0]+o[2]])
                 ok |= np.isclose(sum_phi[0],sum_phi[1],atol=atol)
@@ -550,19 +550,22 @@ class TestRotation:
             assert ok and np.isclose(np.linalg.norm(o[:3]),1.0) and o[3]<=np.pi+1.e-9, f'{m},{o},{rot.as_quaternion()}'
 
     @pytest.mark.parametrize('forward,backward',[(Rotation._ro2qu,Rotation._qu2ro),
-                                                 #(Rotation._ro2om,Rotation._om2ro),
+                                                 (Rotation._ro2om,Rotation._om2ro),
-                                                 #(Rotation._ro2eu,Rotation._eu2ro),
+                                                 (Rotation._ro2eu,Rotation._eu2ro),
                                                  (Rotation._ro2ax,Rotation._ax2ro),
                                                  (Rotation._ro2ho,Rotation._ho2ro),
                                                  (Rotation._ro2cu,Rotation._cu2ro)])
     def test_Rodrigues_internal(self,set_of_rotations,forward,backward):
         """Ensure invariance of conversion from Rodrigues-Frank vector and back."""
-        cutoff = np.tan(np.pi*.5*(1.-1e-4))
+        cutoff = np.tan(np.pi*.5*(1.-1e-5))
         for rot in set_of_rotations:
             m = rot.as_Rodrigues_vector()
             o = backward(forward(m))
             ok = np.allclose(np.clip(m,None,cutoff),np.clip(o,None,cutoff),atol=atol)
-            ok = ok or np.isclose(m[3],0.0,atol=atol)
+            ok |= np.isclose(m[3],0.0,atol=atol)
+            if m[3] > cutoff:
+                ok |= np.allclose(m[:3],-1*o[:3])
+
             assert ok and np.isclose(np.linalg.norm(o[:3]),1.0), f'{m},{o},{rot.as_quaternion()}'
 
     @pytest.mark.parametrize('forward,backward',[(Rotation._ho2qu,Rotation._qu2ho),
@@ -592,7 +595,7 @@ class TestRotation:
             o = backward(forward(m))
             ok = np.allclose(m,o,atol=atol)
             if np.count_nonzero(np.isclose(np.abs(o),np.pi**(2./3.)*.5)):
-                ok = ok or np.allclose(m*-1.,o,atol=atol)
+                ok |= np.allclose(m*-1.,o,atol=atol)
             assert ok and np.max(np.abs(o)) < np.pi**(2./3.) * 0.5 + 1.e-9, f'{m},{o},{rot.as_quaternion()}'
 
     @pytest.mark.parametrize('vectorized, single',[(Rotation._qu2om,qu2om),
@@ -719,7 +722,7 @@ class TestRotation:
             o = Rotation.from_axis_angle(rot.as_axis_angle()).as_axis_angle()
             ok = np.allclose(m,o,atol=atol)
             if np.isclose(m[3],np.pi,atol=atol):
-                ok = ok or np.allclose(m*np.array([-1.,-1.,-1.,1.]),o,atol=atol)
+                ok |= np.allclose(m*np.array([-1.,-1.,-1.,1.]),o,atol=atol)
             assert ok and np.isclose(np.linalg.norm(o[:3]),1.0) \
                       and o[3]<=np.pi+1.e-9, f'{m},{o},{rot.as_quaternion()}'
 
@@ -740,7 +743,7 @@ class TestRotation:
             m = rot.as_Rodrigues_vector()
             o = Rotation.from_homochoric(rot.as_homochoric()*P*-1,P).as_Rodrigues_vector()
             ok = np.allclose(np.clip(m,None,cutoff),np.clip(o,None,cutoff),atol=atol)
-            ok = ok or np.isclose(m[3],0.0,atol=atol)
+            ok |= np.isclose(m[3],0.0,atol=atol)
             assert ok and np.isclose(np.linalg.norm(o[:3]),1.0), f'{m},{o},{rot.as_quaternion()}'
 
     @pytest.mark.parametrize('P',[1,-1])
@@ -780,8 +783,22 @@ class TestRotation:
         else:
             assert r.shape == shape
 
-    def test_equal(self):
+    @pytest.mark.parametrize('shape',[None,5,(4,6)])
-        assert Rotation.from_random(rng_seed=1) == Rotation.from_random(rng_seed=1)
+    def test_equal(self,shape):
+        R = Rotation.from_random(shape,rng_seed=1)
+        assert R == R if shape is None else (R == R).all()
+
+    @pytest.mark.parametrize('shape',[None,5,(4,6)])
+    def test_unequal(self,shape):
+        R = Rotation.from_random(shape,rng_seed=1)
+        assert not (R != R if shape is None else (R != R).any())
+
+
+    def test_equal_ambiguous(self):
+        qu = np.random.rand(10,4)
+        qu[:,0] = 0.
+        qu/=np.linalg.norm(qu,axis=1,keepdims=True)
+        assert (Rotation(qu) == Rotation(-qu)).all()
 
     def test_inversion(self):
         r = Rotation.from_random()
@@ -798,7 +815,15 @@ class TestRotation:
         p = Rotation.from_random(shape=shape)
         s = r.append(p)
         print(f'append 2x {shape} --> {s.shape}')
-        assert s[0,...] == r[0,...] and s[-1,...] == p[-1,...]
+        assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all()
+
+    @pytest.mark.parametrize('shape',[None,1,(1,),(4,2),(3,3,2)])
+    def test_append_list(self,shape):
+        r = Rotation.from_random(shape=shape)
+        p = Rotation.from_random(shape=shape)
+        s = r.append([r,p])
+        print(f'append 3x {shape} --> {s.shape}')
+        assert np.logical_and(s[0,...] == r[0,...], s[-1,...] == p[-1,...]).all()
 
     @pytest.mark.parametrize('quat,standardized',[
                                                   ([-1,0,0,0],[1,0,0,0]),
@@ -820,7 +845,7 @@ class TestRotation:
     @pytest.mark.parametrize('order',['C','F'])
     def test_flatten_reshape(self,shape,order):
         r = Rotation.from_random(shape=shape)
-        assert r == r.flatten(order).reshape(shape,order)
+        assert (r == r.flatten(order).reshape(shape,order)).all()
 
     @pytest.mark.parametrize('function',[Rotation.from_quaternion,
                                          Rotation.from_Euler_angles,
@@ -931,7 +956,7 @@ class TestRotation:
 
     def test_rotate_inverse(self):
         R = Rotation.from_random()
-        assert np.allclose(np.eye(3),(~R@R).as_matrix())
+        assert np.allclose(np.eye(3),(~R*R).as_matrix())
 
     @pytest.mark.parametrize('data',[np.random.rand(3),
                                      np.random.rand(3,3),
@@ -965,6 +990,42 @@ class TestRotation:
         R_2 = Rotation.from_Euler_angles([360,0,0],degrees=True)
         assert np.allclose(R_1.misorientation(R_2).as_matrix(),np.eye(3))
 
+    def test_composition(self):
+        a,b = (Rotation.from_random(),Rotation.from_random())
+        c = a * b
+        a *= b
+        assert c == a
+
+    def test_composition_invalid(self):
+        with pytest.raises(TypeError):
+            Rotation()*np.ones(3)
+
+    def test_composition_inverse(self):
+        a,b = (Rotation.from_random(),Rotation.from_random())
+        c = a / b
+        a /= b
+        assert c == a
+
+    def test_composition_inverse_invalid(self):
+        with pytest.raises(TypeError):
+            Rotation()/np.ones(3)
+
+    def test_power(self):
+        a = Rotation.from_random()
+        r = (np.random.rand()-.5)*4
+        b = a**r
+        a **= r
+        assert a == b
+
+    def test_invariant(self):
+        R = Rotation.from_random()
+        assert R/R == R*R**(-1) == Rotation()
+
+    @pytest.mark.parametrize('item',[np.ones(3),np.ones((3,3)), np.ones((3,3,3,3))])
+    def test_apply(self,item):
+        r = Rotation.from_random()
+        assert (r.apply(item) == r@item).all()
+
     @pytest.mark.parametrize('angle',[10,20,30,40,50,60,70,80,90,100,120])
     def test_average(self,angle):
         R = Rotation.from_axis_angle([[0,0,1,10],[0,0,1,angle]],degrees=True)

python/tests/test_Table.py

@@ -22,7 +22,7 @@ class TestTable:
 
     @pytest.mark.parametrize('N',[10,40])
     def test_len(self,N):
-        len(Table(np.random.rand(N,3),{'X':3})) == N
+        assert len(Table(np.random.rand(N,3),{'X':3})) == N
 
     def test_get_scalar(self,default):
         d = default.get('s')

src/CPFEM.f90

@@ -5,7 +5,6 @@
 !--------------------------------------------------------------------------------------------------
 module CPFEM
   use prec
-  use FEsolving
   use math
   use rotations
   use YAML_types
@@ -13,7 +12,6 @@ module CPFEM
   use discretization_marc
   use material
   use config
-  use crystallite
   use homogenization
   use IO
   use discretization
@@ -89,8 +87,8 @@ subroutine CPFEM_initAll
   call lattice_init
   call material_init(.false.)
   call constitutive_init
-  call crystallite_init
   call homogenization_init
+  call crystallite_init
   call CPFEM_init
   call config_deallocate
 
@@ -153,7 +151,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
                                                       H
 
   integer(pInt)                                       elCP, &                                       ! crystal plasticity element number
-                                                      i, j, k, l, m, n, ph, homog, mySource
+                                                      i, j, k, l, m, n, ph, homog, mySource,ma
 
   real(pReal), parameter ::                          ODD_STRESS    = 1e15_pReal, &                  !< return value for stress if terminallyIll
                                                      ODD_JACOBIAN  = 1e50_pReal                     !< return value for jacobian if terminallyIll
@@ -161,6 +159,8 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
 
   elCP = mesh_FEM2DAMASK_elem(elFE)
 
+  ma = (elCP-1) * discretization_nIPs + ip
+
   if (debugCPFEM%basic .and. elCP == debugCPFEM%element .and. ip == debugCPFEM%ip) then
     print'(/,a)', '#############################################'
     print'(a1,a22,1x,i8,a13)',   '#','element',        elCP,         '#'
@@ -181,11 +181,11 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
 
     chosenThermal1: select case (thermal_type(material_homogenizationAt(elCP)))
       case (THERMAL_conduction_ID) chosenThermal1
-        temperature(material_homogenizationAt(elCP))%p(thermalMapping(material_homogenizationAt(elCP))%p(ip,elCP)) = &
+        temperature(material_homogenizationAt(elCP))%p(material_homogenizationMemberAt(ip,elCP)) = &
           temperature_inp
       end select chosenThermal1
-    homogenization_F0(1:3,1:3,ip,elCP) = ffn
+    homogenization_F0(1:3,1:3,ma) = ffn
-    homogenization_F(1:3,1:3,ip,elCP) = ffn1
+    homogenization_F(1:3,1:3,ma) = ffn1
 
   if (iand(mode, CPFEM_CALCRESULTS) /= 0_pInt) then
 
@@ -196,11 +196,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
       CPFEM_dcsde(1:6,1:6,ip,elCP) = ODD_JACOBIAN * math_eye(6)
 
     else validCalculation
-      FEsolving_execElem = elCP
-      FEsolving_execIP   = ip
       if (debugCPFEM%extensive) &
         print'(a,i8,1x,i2)', '<< CPFEM >> calculation for elFE ip ',elFE,ip
-      call materialpoint_stressAndItsTangent(dt)
+      call materialpoint_stressAndItsTangent(dt,[ip,ip],[elCP,elCP])
 
       terminalIllness: if (terminallyIll) then
 
@@ -212,17 +210,17 @@ subroutine CPFEM_general(mode, ffn, ffn1, temperature_inp, dt, elFE, ip, cauchyS
       else terminalIllness
 
         ! translate from P to sigma
-        Kirchhoff = matmul(homogenization_P(1:3,1:3,ip,elCP), transpose(homogenization_F(1:3,1:3,ip,elCP)))
+        Kirchhoff = matmul(homogenization_P(1:3,1:3,ma), transpose(homogenization_F(1:3,1:3,ma)))
-        J_inverse  = 1.0_pReal / math_det33(homogenization_F(1:3,1:3,ip,elCP))
+        J_inverse  = 1.0_pReal / math_det33(homogenization_F(1:3,1:3,ma))
         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) &
-                     +  homogenization_F(j,m,ip,elCP) * homogenization_F(l,n,ip,elCP) &
+                     +  homogenization_F(j,m,ma) * homogenization_F(l,n,ma) &
-                                                     * homogenization_dPdF(i,m,k,n,ip,elCP) &
+                                                 * homogenization_dPdF(i,m,k,n,ma) &
-                     -  math_delta(j,l) * homogenization_F(i,m,ip,elCP) * homogenization_P(k,m,ip,elCP) &
+                     -  math_delta(j,l) * homogenization_F(i,m,ma) * homogenization_P(k,m,ma) &
                      +  0.5_pReal * (  Kirchhoff(j,l)*math_delta(i,k) + Kirchhoff(i,k)*math_delta(j,l) &
                                      + Kirchhoff(j,k)*math_delta(i,l) + Kirchhoff(i,l)*math_delta(j,k))
         enddo; enddo; enddo; enddo; enddo; enddo
@@ -259,7 +257,8 @@ end subroutine CPFEM_general
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_forward
 
-  call crystallite_forward
+  call homogenization_forward
+  call constitutive_forward
 
 end subroutine CPFEM_forward
 
@@ -275,7 +274,6 @@ subroutine CPFEM_results(inc,time)
   call results_openJobFile
   call results_addIncrement(inc,time)
   call constitutive_results
-  call crystallite_results
   call homogenization_results
   call discretization_results
   call results_finalizeIncrement

src/CPFEM2.f90

@@ -6,7 +6,6 @@
 module CPFEM2
   use prec
   use config
-  use FEsolving
   use math
   use rotations
   use YAML_types
@@ -21,7 +20,6 @@ module CPFEM2
   use HDF5_utilities
   use homogenization
   use constitutive
-  use crystallite
 #if    defined(Mesh)
   use FEM_quadrature
   use discretization_mesh
@@ -63,8 +61,8 @@ subroutine CPFEM_initAll
 #endif
   call material_init(restart=interface_restartInc>0)
   call constitutive_init
-  call crystallite_init
   call homogenization_init
+  call crystallite_init
   call CPFEM_init
   call config_deallocate
 
@@ -76,9 +74,23 @@ end subroutine CPFEM_initAll
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_init
 
+  integer(HID_T) :: fileHandle
+  character(len=pStringLen) :: fileName
+
+
   print'(/,a)', ' <<<+-  CPFEM init  -+>>>'; flush(IO_STDOUT)
 
-  if (interface_restartInc > 0) call crystallite_restartRead
+
+  if (interface_restartInc > 0) then
+    print'(/,a,i0,a)', ' reading restart information of increment from file'; flush(IO_STDOUT)
+    write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5'
+    fileHandle = HDF5_openFile(fileName)
+
+    call homogenization_restartRead(fileHandle)
+    call constitutive_restartRead(fileHandle)
+
+    call HDF5_closeFile(fileHandle)
+  endif
 
 end subroutine CPFEM_init
 
@@ -88,7 +100,19 @@ end subroutine CPFEM_init
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_restartWrite
 
-  call crystallite_restartWrite
+  integer(HID_T) :: fileHandle
+  character(len=pStringLen) :: fileName
+
+
+  print*, ' writing field and constitutive data required for restart to file';flush(IO_STDOUT)
+
+  write(fileName,'(a,i0,a)') trim(getSolverJobName())//'_',worldrank,'.hdf5'
+  fileHandle = HDF5_openFile(fileName,'a')
+
+  call homogenization_restartWrite(fileHandle)
+  call constitutive_restartWrite(fileHandle)
+
+  call HDF5_closeFile(fileHandle)
 
 end subroutine CPFEM_restartWrite
 
@@ -98,7 +122,8 @@ end subroutine CPFEM_restartWrite
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_forward
 
-  call crystallite_forward
+  call homogenization_forward
+  call constitutive_forward
 
 end subroutine CPFEM_forward
 
@@ -114,7 +139,6 @@ subroutine CPFEM_results(inc,time)
   call results_openJobFile
   call results_addIncrement(inc,time)
   call constitutive_results
-  call crystallite_results
   call homogenization_results
   call discretization_results
   call results_finalizeIncrement

src/C_routines.c

@@ -43,7 +43,7 @@ void gethostname_c(char hostname[], int *stat){
 
 
 void getusername_c(char username[], int *stat){
-  struct passwd *pw = getpwuid(geteuid());
+  struct passwd *pw = getpwuid(getuid());
   if(pw && strlen(pw->pw_name) <= STRLEN){
     strncpy(username,pw->pw_name,STRLEN+1);
     *stat = 0;

src/DAMASK_interface.f90

@@ -10,7 +10,7 @@
 !>           and working directory.
 !--------------------------------------------------------------------------------------------------
 #define PETSC_MAJOR 3
-#define PETSC_MINOR_MIN 10
+#define PETSC_MINOR_MIN 12
 #define PETSC_MINOR_MAX 14
 
 module DAMASK_interface
@@ -54,12 +54,6 @@ subroutine DAMASK_interface_init
 ===================================================================================================
 --  WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION ---  WRONG PETSc VERSION --
 ===================================================================================================
-============   THIS VERSION OF DAMASK REQUIRES A DIFFERENT PETSc VERSION   ========================
-===============   THIS VERSION OF DAMASK REQUIRES A DIFFERENT PETSc VERSION   =====================
-==================   THIS VERSION OF DAMASK REQUIRES A DIFFERENT PETSc VERSION   ==================
-===================================================================================================
---  WRONG PETSc VERSION --- WRONG PETSc VERSION --- WRONG PETSc VERSION ---  WRONG PETSc VERSION --
-===================================================================================================
 #endif
 
   character(len=pPathLen*3+pStringLen) :: &
@@ -392,7 +386,7 @@ end function makeRelativePath
 subroutine catchSIGTERM(signal) bind(C)
 
   integer(C_INT), value :: signal
-  interface_SIGTERM = .true.
+  call interface_setSIGTERM(.true.)
 
   print'(a,i0,a)', ' received signal ',signal, ', set SIGTERM=TRUE'
 
@@ -417,7 +411,7 @@ end subroutine interface_setSIGTERM
 subroutine catchSIGUSR1(signal) bind(C)
 
   integer(C_INT), value :: signal
-  interface_SIGUSR1 = .true.
+  call interface_setSIGUSR1(.true.)
 
   print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR1=TRUE'
 
@@ -442,7 +436,7 @@ end subroutine interface_setSIGUSR1
 subroutine catchSIGUSR2(signal) bind(C)
 
   integer(C_INT), value :: signal
-  interface_SIGUSR2 = .true.
+  call interface_setSIGUSR2(.true.)
 
   print'(a,i0,a)', ' received signal ',signal, ', set SIGUSR2=TRUE'
 

src/DAMASK_marc.f90

@@ -176,7 +176,6 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
   use DAMASK_interface
   use config
   use YAML_types
-  use FEsolving
   use discretization_marc
   use homogenization
   use CPFEM
@@ -365,7 +364,8 @@ subroutine flux(f,ts,n,time)
   real(pReal), dimension(2),           intent(out) :: &
     f
 
-  call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1)))
+  f(2) = 0.0_pReal
+  call thermal_conduction_getSource(f(1), ts(3), n(3),mesh_FEM2DAMASK_elem(n(1)))
 
  end subroutine flux
 

src/FEsolving.f90

@@ -1,15 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
-!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief global variables for flow control
-!--------------------------------------------------------------------------------------------------
-module FEsolving
-
-  implicit none
-  public
-
-  integer, dimension(2) :: &
-    FEsolving_execElem, &                                                                           !< for ping-pong scheme always whole range, otherwise one specific element
-    FEsolving_execIP                                                                                !< for ping-pong scheme always range to max IP, otherwise one specific IP
-
-end module FEsolving

src/commercialFEM_fileList.f90

@@ -11,9 +11,7 @@
 #include "config.f90"
 #include "LAPACK_interface.f90"
 #include "math.f90"
-#include "quaternions.f90"
 #include "rotations.f90"
-#include "FEsolving.f90"
 #include "element.f90"
 #include "HDF5_utilities.f90"
 #include "results.f90"
@@ -34,8 +32,8 @@
 #include "constitutive_plastic_disloTungsten.f90"
 #include "constitutive_plastic_nonlocal.f90"
 #include "constitutive_thermal.f90"
-#include "source_thermal_dissipation.f90"
+#include "constitutive_thermal_dissipation.f90"
-#include "source_thermal_externalheat.f90"
+#include "constitutive_thermal_externalheat.f90"
 #include "kinematics_thermal_expansion.f90"
 #include "constitutive_damage.f90"
 #include "source_damage_isoBrittle.f90"
@@ -44,15 +42,14 @@
 #include "source_damage_anisoDuctile.f90"
 #include "kinematics_cleavage_opening.f90"
 #include "kinematics_slipplane_opening.f90"
-#include "crystallite.f90"
 #include "thermal_isothermal.f90"
-#include "thermal_adiabatic.f90"
 #include "thermal_conduction.f90"
 #include "damage_none.f90"
-#include "damage_local.f90"
 #include "damage_nonlocal.f90"
 #include "homogenization.f90"
+#include "homogenization_mech.f90"
 #include "homogenization_mech_none.f90"
 #include "homogenization_mech_isostrain.f90"
 #include "homogenization_mech_RGC.f90"
+#include "homogenization_thermal.f90"
 #include "CPFEM.f90"

src/constitutive_damage.f90

@@ -2,6 +2,16 @@
 !> @brief internal microstructure state for all damage sources and kinematics constitutive models
 !----------------------------------------------------------------------------------------------------
 submodule(constitutive) constitutive_damage
+  enum, bind(c); enumerator :: &
+    DAMAGE_UNDEFINED_ID, &
+    DAMAGE_ISOBRITTLE_ID, &
+    DAMAGE_ISODUCTILE_ID, &
+    DAMAGE_ANISOBRITTLE_ID, &
+    DAMAGE_ANISODUCTILE_ID
+  end enum
+
+  integer(kind(DAMAGE_UNDEFINED_ID)),     dimension(:,:), allocatable :: &
+    phase_source                                                                                !< active sources mechanisms of each phase
 
   interface
 
@@ -119,24 +129,24 @@ module subroutine damage_init
 
   phases => config_material%get('phase')
 
-  allocate(sourceState (phases%length))
+  allocate(damageState (phases%length))
   allocate(phase_Nsources(phases%length),source = 0)           ! same for kinematics
 
   do ph = 1,phases%length
     phase => phases%get(ph)
     sources => phase%get('source',defaultVal=emptyList)
     phase_Nsources(ph) = sources%length
-    allocate(sourceState(ph)%p(phase_Nsources(ph)))
+    allocate(damageState(ph)%p(phase_Nsources(ph)))
   enddo
 
-  allocate(phase_source(maxval(phase_Nsources),phases%length), source = SOURCE_undefined_ID) 
+  allocate(phase_source(maxval(phase_Nsources),phases%length), source = DAMAGE_UNDEFINED_ID)
 
 ! initialize source mechanisms
   if(maxval(phase_Nsources) /= 0) then
-    where(source_damage_isoBrittle_init   (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoBrittle_ID
+    where(source_damage_isoBrittle_init   (maxval(phase_Nsources))) phase_source = DAMAGE_ISOBRITTLE_ID
-    where(source_damage_isoDuctile_init   (maxval(phase_Nsources))) phase_source = SOURCE_damage_isoDuctile_ID
+    where(source_damage_isoDuctile_init   (maxval(phase_Nsources))) phase_source = DAMAGE_ISODUCTILE_ID
-    where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoBrittle_ID
+    where(source_damage_anisoBrittle_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISOBRITTLE_ID
-    where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = SOURCE_damage_anisoDuctile_ID
+    where(source_damage_anisoDuctile_init (maxval(phase_Nsources))) phase_source = DAMAGE_ANISODUCTILE_ID
   endif
 
 !--------------------------------------------------------------------------------------------------
@@ -189,16 +199,16 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi
      constituent = material_phasememberAt(grain,ip,el)
      do source = 1, phase_Nsources(phase)
        select case(phase_source(source,phase))
-         case (SOURCE_damage_isoBrittle_ID)
+         case (DAMAGE_ISOBRITTLE_ID)
            call source_damage_isobrittle_getRateAndItsTangent  (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
 
-         case (SOURCE_damage_isoDuctile_ID)
+         case (DAMAGE_ISODUCTILE_ID)
            call source_damage_isoductile_getRateAndItsTangent  (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
 
-         case (SOURCE_damage_anisoBrittle_ID)
+         case (DAMAGE_ANISOBRITTLE_ID)
            call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
 
-         case (SOURCE_damage_anisoDuctile_ID)
+         case (DAMAGE_ANISODUCTILE_ID)
            call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
 
          case default
@@ -214,37 +224,264 @@ module subroutine constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi
 end subroutine constitutive_damage_getRateAndItsTangents
 
 
+
+!--------------------------------------------------------------------------------------------------
+!> @brief integrate stress, state with adaptive 1st order explicit Euler method
+!> using Fixed Point Iteration to adapt the stepsize
+!--------------------------------------------------------------------------------------------------
+module function integrateDamageState(dt,co,ip,el) result(broken)
+
+  real(pReal), intent(in) :: dt
+  integer, intent(in) :: &
+    el, &                                                                                            !< element index in element loop
+    ip, &                                                                                            !< integration point index in ip loop
+    co                                                                                               !< grain index in grain loop
+  logical :: broken
+
+  integer :: &
+    NiterationState, &                                                                              !< number of iterations in state loop
+    ph, &
+    me, &
+    so
+  integer, dimension(maxval(phase_Nsources)) :: &
+    size_so
+  real(pReal) :: &
+    zeta
+  real(pReal), dimension(constitutive_source_maxSizeDotState) :: &
+    r                                                                                               ! state residuum
+  real(pReal), dimension(constitutive_source_maxSizeDotState,2,maxval(phase_Nsources)) :: source_dotState
+  logical :: &
+    converged_
+
+
+  ph = material_phaseAt(co,el)
+  me = material_phaseMemberAt(co,ip,el)
+
+  converged_ = .true.
+  broken = constitutive_damage_collectDotState(co,ip,el,ph,me)
+  if(broken) return
+
+  do so = 1, phase_Nsources(ph)
+    size_so(so) = damageState(ph)%p(so)%sizeDotState
+    damageState(ph)%p(so)%state(1:size_so(so),me) = damageState(ph)%p(so)%subState0(1:size_so(so),me) &
+                                                  + damageState(ph)%p(so)%dotState (1:size_so(so),me) * dt
+    source_dotState(1:size_so(so),2,so) = 0.0_pReal
+  enddo
+
+  iteration: do NiterationState = 1, num%nState
+
+    do so = 1, phase_Nsources(ph)
+      if(nIterationState > 1) source_dotState(1:size_so(so),2,so) = source_dotState(1:size_so(so),1,so)
+      source_dotState(1:size_so(so),1,so) = damageState(ph)%p(so)%dotState(:,me)
+    enddo
+
+    broken = constitutive_damage_collectDotState(co,ip,el,ph,me)
+    if(broken) exit iteration
+
+    do so = 1, phase_Nsources(ph)
+      zeta = damper(damageState(ph)%p(so)%dotState(:,me), &
+                    source_dotState(1:size_so(so),1,so),&
+                    source_dotState(1:size_so(so),2,so))
+      damageState(ph)%p(so)%dotState(:,me) = damageState(ph)%p(so)%dotState(:,me) * zeta &
+                                        + source_dotState(1:size_so(so),1,so)* (1.0_pReal - zeta)
+      r(1:size_so(so)) = damageState(ph)%p(so)%state    (1:size_so(so),me)  &
+                       - damageState(ph)%p(so)%subState0(1:size_so(so),me)  &
+                       - damageState(ph)%p(so)%dotState (1:size_so(so),me) * dt
+      damageState(ph)%p(so)%state(1:size_so(so),me) = damageState(ph)%p(so)%state(1:size_so(so),me) &
+                                                - r(1:size_so(so))
+      converged_ = converged_  .and. converged(r(1:size_so(so)), &
+                                               damageState(ph)%p(so)%state(1:size_so(so),me), &
+                                               damageState(ph)%p(so)%atol(1:size_so(so)))
+    enddo
+
+    if(converged_) then
+      broken = constitutive_damage_deltaState(mech_F_e(ph,me),co,ip,el,ph,me)
+      exit iteration
+    endif
+
+  enddo iteration
+
+  broken = broken .or. .not. converged_
+
+
+  contains
+
+  !--------------------------------------------------------------------------------------------------
+  !> @brief calculate the damping for correction of state and dot state
+  !--------------------------------------------------------------------------------------------------
+  real(pReal) pure function damper(current,previous,previous2)
+
+  real(pReal), dimension(:), intent(in) ::&
+    current, previous, previous2
+
+  real(pReal) :: dot_prod12, dot_prod22
+
+  dot_prod12 = dot_product(current  - previous,  previous - previous2)
+  dot_prod22 = dot_product(previous - previous2, previous - previous2)
+  if ((dot_product(current,previous) < 0.0_pReal .or. dot_prod12 < 0.0_pReal) .and. dot_prod22 > 0.0_pReal) then
+    damper = 0.75_pReal + 0.25_pReal * tanh(2.0_pReal + 4.0_pReal * dot_prod12 / dot_prod22)
+  else
+    damper = 1.0_pReal
+  endif
+
+  end function damper
+
+end function integrateDamageState
+
+
 !----------------------------------------------------------------------------------------------
 !< @brief writes damage sources results to HDF5 output file
 !----------------------------------------------------------------------------------------------
-module subroutine damage_results
+module subroutine damage_results(group,ph)
 
-  integer :: p,i
+  character(len=*), intent(in) :: group
-  character(len=pStringLen) :: group
+  integer,          intent(in) :: ph
 
-  do p = 1, size(material_name_phase)
+  integer :: so
 
-    sourceLoop: do i = 1, phase_Nsources(p)
+  sourceLoop: do so = 1, phase_Nsources(ph)
-    group = trim('current/phase')//'/'//trim(material_name_phase(p))
-    group = trim(group)//'/sources'
-    call results_closeGroup(results_addGroup(group))
 
-      sourceType: select case (phase_source(i,p))
+  if (phase_source(so,ph) /= DAMAGE_UNDEFINED_ID) &
+    call results_closeGroup(results_addGroup(group//'sources/')) ! should be 'damage'
 
-        case (SOURCE_damage_anisoBrittle_ID) sourceType
+    sourceType: select case (phase_source(so,ph))
-          call source_damage_anisoBrittle_results(p,group)
-        case (SOURCE_damage_anisoDuctile_ID) sourceType
-          call source_damage_anisoDuctile_results(p,group)
-        case (SOURCE_damage_isoBrittle_ID) sourceType
-          call source_damage_isoBrittle_results(p,group)
-        case (SOURCE_damage_isoDuctile_ID) sourceType
-          call source_damage_isoDuctile_results(p,group)
-      end select sourceType
 
-    enddo SourceLoop
+      case (DAMAGE_ISOBRITTLE_ID) sourceType
-  enddo
+        call source_damage_isoBrittle_results(ph,group//'sources/')
+
+      case (DAMAGE_ISODUCTILE_ID) sourceType
+        call source_damage_isoDuctile_results(ph,group//'sources/')
+
+      case (DAMAGE_ANISOBRITTLE_ID) sourceType
+        call source_damage_anisoBrittle_results(ph,group//'sources/')
+
+      case (DAMAGE_ANISODUCTILE_ID) sourceType
+        call source_damage_anisoDuctile_results(ph,group//'sources/')
+
+    end select sourceType
+
+  enddo SourceLoop
 
 end subroutine damage_results
 
 
+!--------------------------------------------------------------------------------------------------
+!> @brief contains the constitutive equation for calculating the rate of change of microstructure
+!--------------------------------------------------------------------------------------------------
+function constitutive_damage_collectDotState(co,ip,el,ph,of) result(broken)
+
+  integer, intent(in) :: &
+    co, &                                                                                          !< component-ID of integration point
+    ip, &                                                                                           !< integration point
+    el, &                                                                                           !< element
+    ph, &
+    of
+  integer :: &
+    so                                                                                               !< counter in source loop
+  logical :: broken
+
+
+  broken = .false.
+
+  SourceLoop: do so = 1, phase_Nsources(ph)
+
+    sourceType: select case (phase_source(so,ph))
+
+      case (DAMAGE_ISODUCTILE_ID) sourceType
+        call source_damage_isoDuctile_dotState(co, ip, el)
+
+      case (DAMAGE_ANISODUCTILE_ID) sourceType
+        call source_damage_anisoDuctile_dotState(co, ip, el)
+
+      case (DAMAGE_ANISOBRITTLE_ID) sourceType
+        call source_damage_anisoBrittle_dotState(mech_S(material_phaseAt(co,el),material_phaseMemberAt(co,ip,el)),&
+                co, ip, el) ! correct stress?
+
+    end select sourceType
+
+    broken = broken .or. any(IEEE_is_NaN(damageState(ph)%p(so)%dotState(:,of)))
+
+  enddo SourceLoop
+
+end function constitutive_damage_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
+!--------------------------------------------------------------------------------------------------
+function constitutive_damage_deltaState(Fe, co, ip, el, ph, of) result(broken)
+
+  integer, intent(in) :: &
+    co, &                                                                                          !< component-ID of integration point
+    ip, &                                                                                           !< integration point
+    el, &                                                                                           !< element
+    ph, &
+    of
+  real(pReal),   intent(in), dimension(3,3) :: &
+    Fe                                                                                              !< elastic deformation gradient
+  integer :: &
+    so, &
+    myOffset, &
+    mySize
+  logical :: &
+    broken
+
+
+  broken = .false.
+
+  sourceLoop: do so = 1, phase_Nsources(ph)
+
+     sourceType: select case (phase_source(so,ph))
+
+      case (DAMAGE_ISOBRITTLE_ID) sourceType
+        call source_damage_isoBrittle_deltaState  (constitutive_homogenizedC(co,ip,el), Fe, &
+                                                   co, ip, el)
+        broken = any(IEEE_is_NaN(damageState(ph)%p(so)%deltaState(:,of)))
+        if(.not. broken) then
+          myOffset = damageState(ph)%p(so)%offsetDeltaState
+          mySize   = damageState(ph)%p(so)%sizeDeltaState
+          damageState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) = &
+          damageState(ph)%p(so)%state(myOffset + 1: myOffset + mySize,of) + damageState(ph)%p(so)%deltaState(1:mySize,of)
+        endif
+
+    end select sourceType
+
+  enddo SourceLoop
+
+end function constitutive_damage_deltaState
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief checks if a source mechanism is active or not
+!--------------------------------------------------------------------------------------------------
+function source_active(source_label,src_length)  result(active_source)
+
+  character(len=*), intent(in)         :: source_label                                              !< name of source mechanism
+  integer,          intent(in)         :: src_length                                                !< max. number of sources in system
+  logical, dimension(:,:), allocatable :: active_source
+
+  class(tNode), pointer :: &
+    phases, &
+    phase, &
+    sources, &
+    src
+  integer :: p,s
+
+  phases => config_material%get('phase')
+  allocate(active_source(src_length,phases%length), source = .false. )
+  do p = 1, phases%length
+    phase => phases%get(p)
+    sources => phase%get('source',defaultVal=emptyList)
+    do s = 1, sources%length
+      src => sources%get(s)
+      if(src%get_asString('type') == source_label) active_source(s,p) = .true.
+    enddo
+  enddo
+
+
+end function source_active
+
+
 end submodule constitutive_damage

src/constitutive_plastic_dislotwin.f90

@@ -485,12 +485,12 @@ end function plastic_dislotwin_init
 !--------------------------------------------------------------------------------------------------
 !> @brief Return the homogenized elasticity matrix.
 !--------------------------------------------------------------------------------------------------
-module function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC)
+module function plastic_dislotwin_homogenizedC(co,ip,el) result(homogenizedC)
 
   real(pReal), dimension(6,6) :: &
     homogenizedC
   integer,     intent(in) :: &
-    ipc, &                                                                                          !< component-ID of integration point
+    co, &                                                                                          !< component-ID of integration point
     ip, &                                                                                           !< integration point
     el                                                                                              !< element
 
@@ -498,9 +498,9 @@ module function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC)
              of
   real(pReal) :: f_unrotated
 
-  of = material_phasememberAt(ipc,ip,el)
+  of = material_phasememberAt(co,ip,el)
-  associate(prm => param(phase_plasticityInstance(material_phaseAt(ipc,el))),&
+  associate(prm => param(phase_plasticityInstance(material_phaseAt(co,el))),&
-            stt => state(phase_plasticityInstance(material_phaseAT(ipc,el))))
+            stt => state(phase_plasticityInstance(material_phaseAT(co,el))))
 
   f_unrotated = 1.0_pReal &
               - sum(stt%f_tw(1:prm%sum_N_tw,of)) &

src/constitutive_plastic_nonlocal.f90

@@ -10,7 +10,8 @@ submodule(constitutive:constitutive_mech) plastic_nonlocal
     IPneighborhood  => geometry_plastic_nonlocal_IPneighborhood, &
     IPvolume        => geometry_plastic_nonlocal_IPvolume0, &
     IParea          => geometry_plastic_nonlocal_IParea0, &
-    IPareaNormal    => geometry_plastic_nonlocal_IPareaNormal0
+    IPareaNormal    => geometry_plastic_nonlocal_IPareaNormal0, &
+    geometry_plastic_nonlocal_disable
 
   real(pReal), parameter :: &
     kB = 1.38e-23_pReal                                                                             !< Boltzmann constant in J/Kelvin
@@ -551,11 +552,8 @@ end function plastic_nonlocal_init
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates quantities characterizing the microstructure
 !--------------------------------------------------------------------------------------------------
-module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el)
+module subroutine plastic_nonlocal_dependentState(instance, of, ip, el)
 
-  real(pReal), dimension(3,3), intent(in) :: &
-    F, &
-    Fp
   integer, intent(in) :: &
     instance, &
     of, &
@@ -563,6 +561,8 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el)
     el
 
   integer :: &
+    ph, &
+    me, &
     no, &                                                                                           !< neighbor offset
     neighbor_el, &                                                                                  ! element number of neighboring material point
     neighbor_ip, &                                                                                  ! integration point of neighboring material point
@@ -642,8 +642,10 @@ module subroutine plastic_nonlocal_dependentState(F, Fp, instance, of, ip, el)
 
   rho0 = getRho0(instance,of,ip,el)
   if (.not. phase_localPlasticity(material_phaseAt(1,el)) .and. prm%shortRangeStressCorrection) then
-    invFp = math_inv33(Fp)
+    ph = material_phaseAt(1,el)
-    invFe = matmul(Fp,math_inv33(F))
+    me = material_phaseMemberAt(1,ip,el)
+    invFp = math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,me))
+    invFe = math_inv33(constitutive_mech_Fe(ph)%data(1:3,1:3,me))
 
     rho_edg_delta = rho0(:,mob_edg_pos) - rho0(:,mob_edg_neg)
     rho_scr_delta = rho0(:,mob_scr_pos) - rho0(:,mob_scr_neg)
@@ -972,14 +974,11 @@ end subroutine plastic_nonlocal_deltaState
 !---------------------------------------------------------------------------------------------------
 !> @brief calculates the rate of change of microstructure
 !---------------------------------------------------------------------------------------------------
-module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
+module subroutine plastic_nonlocal_dotState(Mp, Temperature,timestep, &
                                             instance,of,ip,el)
 
   real(pReal), dimension(3,3), intent(in) :: &
     Mp                                                                                              !< MandelStress
-  real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: &
-    F, &                                                                                            !< elastic deformation gradient
-    Fp                                                                                              !< plastic deformation gradient
   real(pReal), intent(in) :: &
     Temperature, &                                                                                  !< temperature
     timestep                                                                                        !< substepped crystallite time increment
@@ -1146,7 +1145,7 @@ module subroutine plastic_nonlocal_dotState(Mp, F, Fp, Temperature,timestep, &
                                          - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) &
                                                                   - rhoDotSingle2DipoleGlide(s,9))  ! make sure that we do not annihilate more dipoles than we have
 
-  rhoDot = rhoDotFlux(F,Fp,timestep,  instance,of,ip,el) &
+  rhoDot = rhoDotFlux(timestep, instance,of,ip,el) &
          + rhoDotMultiplication &
          + rhoDotSingle2DipoleGlide &
          + rhoDotAthermalAnnihilation &
@@ -1175,11 +1174,8 @@ end subroutine plastic_nonlocal_dotState
 !---------------------------------------------------------------------------------------------------
 !> @brief calculates the rate of change of microstructure
 !---------------------------------------------------------------------------------------------------
-function rhoDotFlux(F,Fp,timestep,  instance,of,ip,el)
+function rhoDotFlux(timestep,instance,of,ip,el)
 
-  real(pReal), dimension(3,3,homogenization_maxNconstituents,discretization_nIPs,discretization_Nelems), intent(in) :: &
-    F, &                                                                                            !< elastic deformation gradient
-    Fp                                                                                              !< plastic deformation gradient
   real(pReal), intent(in) :: &
     timestep                                                                                        !< substepped crystallite time increment
   integer, intent(in) :: &
@@ -1291,8 +1287,8 @@ function rhoDotFlux(F,Fp,timestep,  instance,of,ip,el)
     m(1:3,:,3) = -prm%slip_transverse
     m(1:3,:,4) =  prm%slip_transverse
 
-    my_F = F(1:3,1:3,1,ip,el)
+    my_F = constitutive_mech_F(ph)%data(1:3,1:3,of)
-    my_Fe = matmul(my_F, math_inv33(Fp(1:3,1:3,1,ip,el)))
+    my_Fe = matmul(my_F, math_inv33(constitutive_mech_Fp(ph)%data(1:3,1:3,of)))
 
     neighbors: do n = 1,nIPneighbors
 
@@ -1309,8 +1305,8 @@ function rhoDotFlux(F,Fp,timestep,  instance,of,ip,el)
 
       if (neighbor_n > 0) then                                                                      ! if neighbor exists, average deformation gradient
         neighbor_instance = phase_plasticityInstance(material_phaseAt(1,neighbor_el))
-        neighbor_F = F(1:3,1:3,1,neighbor_ip,neighbor_el)
+        neighbor_F = constitutive_mech_F(np)%data(1:3,1:3,no)
-        neighbor_Fe = matmul(neighbor_F, math_inv33(Fp(1:3,1:3,1,neighbor_ip,neighbor_el)))
+        neighbor_Fe = matmul(neighbor_F, math_inv33(constitutive_mech_Fp(np)%data(1:3,1:3,no)))
         Favg = 0.5_pReal * (my_F + neighbor_F)
       else                                                                                          ! if no neighbor, take my value as average
         Favg = my_F

src/constitutive_thermal.f90

@@ -3,6 +3,21 @@
 !----------------------------------------------------------------------------------------------------
 submodule(constitutive) constitutive_thermal
 
+  enum, bind(c); enumerator :: &
+    THERMAL_UNDEFINED_ID ,&
+    THERMAL_DISSIPATION_ID, &
+    THERMAL_EXTERNALHEAT_ID
+  end enum
+
+  type :: tDataContainer
+    real(pReal), dimension(:), allocatable :: T
+  end type tDataContainer
+  integer(kind(THERMAL_UNDEFINED_ID)),     dimension(:,:), allocatable :: &
+    thermal_source
+
+  type(tDataContainer), dimension(:), allocatable :: current
+
+  integer :: thermal_source_maxSizeDotState
   interface
 
   module function source_thermal_dissipation_init(source_length) result(mySources)
@@ -21,7 +36,7 @@ submodule(constitutive) constitutive_thermal
   end function kinematics_thermal_expansion_init
 
 
-  module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase)
+  module subroutine thermal_dissipation_getRate(TDot, Tstar,Lp,phase)
     integer, intent(in) :: &
       phase                                                                                         !< phase ID of element
     real(pReal),  intent(in), dimension(3,3) :: &
@@ -29,18 +44,16 @@ submodule(constitutive) constitutive_thermal
     real(pReal),  intent(in), dimension(3,3) :: &
       Lp                                                                                            !< plastic velocuty gradient for a given element
     real(pReal),  intent(out) :: &
-      TDot, &
+      TDot
-      dTDot_dT
+  end subroutine thermal_dissipation_getRate
-  end subroutine source_thermal_dissipation_getRateAndItsTangent
 
-  module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of)
+  module subroutine thermal_externalheat_getRate(TDot, phase,of)
     integer, intent(in) :: &
       phase, &
       of
     real(pReal),  intent(out) :: &
-      TDot, &
+      TDot
-      dTDot_dT
+  end subroutine thermal_externalheat_getRate
-  end subroutine source_thermal_externalheat_getRateAndItsTangent
 
  end interface
 
@@ -49,14 +62,60 @@ contains
 !----------------------------------------------------------------------------------------------
 !< @brief initializes thermal sources and kinematics mechanism
 !----------------------------------------------------------------------------------------------
-module subroutine thermal_init
+module subroutine thermal_init(phases)
 
-! initialize source mechanisms
+  class(tNode), pointer :: &
-  if(maxval(phase_Nsources) /= 0) then
+    phases
-    where(source_thermal_dissipation_init (maxval(phase_Nsources))) phase_source = SOURCE_thermal_dissipation_ID
+
-    where(source_thermal_externalheat_init(maxval(phase_Nsources))) phase_source = SOURCE_thermal_externalheat_ID
+  class(tNode), pointer :: &
+    phase, thermal, sources
+
+  integer :: &
+    ph, so, &
+    Nconstituents
+
+
+  print'(/,a)', ' <<<+-  constitutive_thermal init  -+>>>'
+
+  allocate(current(phases%length))
+
+  allocate(thermalState (phases%length))
+  allocate(thermal_Nsources(phases%length),source = 0)
+
+  do ph = 1, phases%length
+
+    Nconstituents = count(material_phaseAt == ph) * discretization_nIPs
+
+    allocate(current(ph)%T(Nconstituents))
+    phase => phases%get(ph)
+    if(phase%contains('thermal')) then
+      thermal => phase%get('thermal')
+      sources => thermal%get('source',defaultVal=emptyList)
+
+      thermal_Nsources(ph) = sources%length
+    endif
+    allocate(thermalstate(ph)%p(thermal_Nsources(ph)))
+  enddo
+
+  allocate(thermal_source(maxval(thermal_Nsources),phases%length), source = THERMAL_UNDEFINED_ID)
+
+  if(maxval(thermal_Nsources) /= 0) then
+    where(source_thermal_dissipation_init (maxval(thermal_Nsources))) thermal_source = THERMAL_DISSIPATION_ID
+    where(source_thermal_externalheat_init(maxval(thermal_Nsources))) thermal_source = THERMAL_EXTERNALHEAT_ID
   endif
 
+  thermal_source_maxSizeDotState = 0
+  PhaseLoop2:do ph = 1,phases%length
+
+    do so = 1,thermal_Nsources(ph)
+      thermalState(ph)%p(so)%partitionedState0 = thermalState(ph)%p(so)%state0
+      thermalState(ph)%p(so)%state             = thermalState(ph)%p(so)%partitionedState0
+    enddo
+
+    thermal_source_maxSizeDotState   = max(thermal_source_maxSizeDotState, &
+                                                maxval(thermalState(ph)%p%sizeDotState))
+  enddo PhaseLoop2
+
 !--------------------------------------------------------------------------------------------------
 !initialize kinematic mechanisms
   if(maxval(phase_Nkinematics) /= 0) where(kinematics_thermal_expansion_init(maxval(phase_Nkinematics))) &
@@ -68,58 +127,236 @@ end subroutine thermal_init
 !----------------------------------------------------------------------------------------------
 !< @brief calculates thermal dissipation rate
 !----------------------------------------------------------------------------------------------
-module subroutine constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, S, Lp, ip, el)
+module subroutine constitutive_thermal_getRate(TDot, T, ip, el)
+
   integer, intent(in) :: &
     ip, &                                                                                           !< integration point number
     el                                                                                              !< element number
   real(pReal), intent(in) :: &
-    T
+    T                                                                                             !< plastic velocity gradient
-  real(pReal),  intent(in), dimension(:,:,:,:,:) :: &
+  real(pReal), intent(out) :: &
-    S, &                                                                                            !< current 2nd Piola Kirchhoff stress
+    TDot
-    Lp                                                                                              !< plastic velocity gradient
-  real(pReal), intent(inout) :: &
-    TDot, &
-    dTDot_dT
 
   real(pReal) :: &
-    my_Tdot, &
+    my_Tdot
-    my_dTdot_dT
   integer :: &
-    phase, &
+    ph, &
     homog, &
     instance, &
-    grain, &
+    me, &
-    source, &
+    so, &
-    constituent
+    co
 
    homog  = material_homogenizationAt(el)
    instance = thermal_typeInstance(homog)
 
-  do grain = 1, homogenization_Nconstituents(homog)
+  TDot = 0.0_pReal
-     phase = material_phaseAt(grain,el)
+  do co = 1, homogenization_Nconstituents(homog)
-     constituent = material_phasememberAt(grain,ip,el)
+     ph = material_phaseAt(co,el)
-     do source = 1, phase_Nsources(phase)
+     me = material_phasememberAt(co,ip,el)
-       select case(phase_source(source,phase))
+     do so = 1, thermal_Nsources(ph)
-         case (SOURCE_thermal_dissipation_ID)
+       select case(thermal_source(so,ph))
-          call source_thermal_dissipation_getRateAndItsTangent(my_Tdot, my_dTdot_dT, &
+         case (THERMAL_DISSIPATION_ID)
-                                                               S(1:3,1:3,grain,ip,el), &
+          call thermal_dissipation_getRate(my_Tdot, mech_S(ph,me),mech_L_p(ph,me),ph)
-                                                                Lp(1:3,1:3,grain,ip,el), &
-                                                                    phase)
 
-         case (SOURCE_thermal_externalheat_ID)
+         case (THERMAL_EXTERNALHEAT_ID)
-          call source_thermal_externalheat_getRateAndItsTangent(my_Tdot, my_dTdot_dT, &
+          call thermal_externalheat_getRate(my_Tdot, ph,me)
-                                                                phase, constituent)
 
          case default
           my_Tdot = 0.0_pReal
-          my_dTdot_dT = 0.0_pReal
        end select
        Tdot = Tdot + my_Tdot
-       dTdot_dT = dTdot_dT + my_dTdot_dT
      enddo
    enddo
 
-end subroutine constitutive_thermal_getRateAndItsTangents
+end subroutine constitutive_thermal_getRate
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief contains the constitutive equation for calculating the rate of change of microstructure
+!--------------------------------------------------------------------------------------------------
+function constitutive_thermal_collectDotState(ph,me) result(broken)
+
+  integer, intent(in) :: ph, me
+  logical :: broken
+
+  integer :: i
+
+
+  broken = .false.
+
+  SourceLoop: do i = 1, thermal_Nsources(ph)
+
+    if (thermal_source(i,ph) == THERMAL_EXTERNALHEAT_ID) &
+      call source_thermal_externalheat_dotState(ph,me)
+
+    broken = broken .or. any(IEEE_is_NaN(thermalState(ph)%p(i)%dotState(:,me)))
+
+  enddo SourceLoop
+
+end function constitutive_thermal_collectDotState
+
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief integrate state with 1st order explicit Euler method
+!--------------------------------------------------------------------------------------------------
+module function integrateThermalState(Delta_t,co,ip,el) result(broken)
+
+  real(pReal), intent(in) :: Delta_t
+  integer, intent(in) :: &
+    el, &                                                                                            !< element index in element loop
+    ip, &                                                                                            !< integration point index in ip loop
+    co                                                                                               !< grain index in grain loop
+  logical :: &
+    broken
+
+  integer :: &
+    ph, &
+    me, &
+    so, &
+    sizeDotState
+
+
+  ph = material_phaseAt(co,el)
+  me = material_phaseMemberAt(co,ip,el)
+
+  broken = constitutive_thermal_collectDotState(ph,me)
+  if(broken) return
+
+  do so = 1, thermal_Nsources(ph)
+    sizeDotState = thermalState(ph)%p(so)%sizeDotState
+    thermalState(ph)%p(so)%state(1:sizeDotState,me) = thermalState(ph)%p(so)%subState0(1:sizeDotState,me) &
+                                                    + thermalState(ph)%p(so)%dotState(1:sizeDotState,me) * Delta_t
+  enddo
+
+end function integrateThermalState
+
+
+module subroutine thermal_initializeRestorationPoints(ph,me)
+
+  integer, intent(in) :: ph, me
+
+  integer :: so
+
+
+  do so = 1, size(thermalState(ph)%p)
+    thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state0(:,me)
+  enddo
+
+end subroutine thermal_initializeRestorationPoints
+
+
+
+module subroutine thermal_windForward(ph,me)
+
+  integer, intent(in) :: ph, me
+
+  integer :: so
+
+
+  do so = 1, size(thermalState(ph)%p)
+    thermalState(ph)%p(so)%partitionedState0(:,me) = thermalState(ph)%p(so)%state(:,me)
+  enddo
+
+end subroutine thermal_windForward
+
+
+module subroutine thermal_forward()
+
+  integer :: ph, so
+
+
+  do ph = 1, size(thermalState)
+    do so = 1, size(thermalState(ph)%p)
+      thermalState(ph)%p(so)%state0 = thermalState(ph)%p(so)%state
+    enddo
+  enddo
+
+end subroutine thermal_forward
+
+
+module subroutine thermal_restore(ip,el)
+
+  integer, intent(in) :: ip, el
+
+  integer :: co, ph, me, so
+
+
+  do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
+    ph = material_phaseAt(co,el)
+    me = material_phaseMemberAt(co,ip,el)
+
+    do so = 1, size(thermalState(ph)%p)
+      thermalState(ph)%p(so)%state(:,me) = thermalState(ph)%p(so)%partitionedState0(:,me)
+    enddo
+
+  enddo
+
+end subroutine thermal_restore
+
+
+!----------------------------------------------------------------------------------------------
+!< @brief Get temperature (for use by non-thermal physics)
+!----------------------------------------------------------------------------------------------
+module function thermal_T(ph,me) result(T)
+
+  integer, intent(in) :: ph, me
+  real(pReal) :: T
+
+
+  T = current(ph)%T(me)
+
+end function thermal_T
+
+
+!----------------------------------------------------------------------------------------------
+!< @brief Set temperature
+!----------------------------------------------------------------------------------------------
+module subroutine constitutive_thermal_setT(T,co,ip,el)
+
+  real(pReal), intent(in) :: T
+  integer, intent(in) :: co, ip, el
+
+
+  current(material_phaseAt(co,el))%T(material_phaseMemberAt(co,ip,el)) = T
+
+end subroutine constitutive_thermal_setT
+
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief checks if a source mechanism is active or not
+!--------------------------------------------------------------------------------------------------
+function thermal_active(source_label,src_length)  result(active_source)
+
+  character(len=*), intent(in)         :: source_label                                              !< name of source mechanism
+  integer,          intent(in)         :: src_length                                                !< max. number of sources in system
+  logical, dimension(:,:), allocatable :: active_source
+
+  class(tNode), pointer :: &
+    phases, &
+    phase, &
+    sources, thermal, &
+    src
+  integer :: p,s
+
+  phases => config_material%get('phase')
+  allocate(active_source(src_length,phases%length), source = .false. )
+  do p = 1, phases%length
+    phase => phases%get(p)
+    if (phase%contains('thermal')) then
+      thermal =>  phase%get('thermal',defaultVal=emptyList)
+      sources =>  thermal%get('source',defaultVal=emptyList)
+      do s = 1, sources%length
+        src => sources%get(s)
+        if(src%get_asString('type') == source_label) active_source(s,p) = .true.
+      enddo
+    endif
+  enddo
+
+
+end function thermal_active
 
 
 end submodule constitutive_thermal

src/constitutive_thermal_dissipation.f90

@@ -4,7 +4,7 @@
 !> @brief material subroutine for thermal source due to plastic dissipation
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
-submodule(constitutive:constitutive_thermal) source_thermal_dissipation
+submodule(constitutive:constitutive_thermal) source_dissipation
 
   integer,           dimension(:),   allocatable :: &
     source_thermal_dissipation_offset, &                                                            !< which source is my current thermal dissipation mechanism?
@@ -33,13 +33,14 @@ module function source_thermal_dissipation_init(source_length) result(mySources)
   class(tNode), pointer :: &
     phases, &
     phase, &
-    sources, &
+    sources, thermal, &
     src
   integer :: Ninstances,sourceOffset,Nconstituents,p
 
-  print'(/,a)', ' <<<+-  source_thermal_dissipation init  -+>>>'
+  print'(/,a)', ' <<<+-  thermal_dissipation init  -+>>>'
+
+  mySources = thermal_active('dissipation',source_length)
 
-  mySources = source_active('thermal_dissipation',source_length)
   Ninstances = count(mySources)
   print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT)
   if(Ninstances == 0) return
@@ -51,18 +52,19 @@ module function source_thermal_dissipation_init(source_length) result(mySources)
 
   do p = 1, phases%length
     phase => phases%get(p)
-    if(count(mySources(:,p)) == 0) cycle
     if(any(mySources(:,p))) source_thermal_dissipation_instance(p) = count(mySources(:,1:p))
-    sources => phase%get('source')
+    if(count(mySources(:,p)) == 0) cycle
+    thermal => phase%get('thermal')
+    sources => thermal%get('source')
     do sourceOffset = 1, sources%length
       if(mySources(sourceOffset,p)) then
         source_thermal_dissipation_offset(p) = sourceOffset
         associate(prm  => param(source_thermal_dissipation_instance(p)))
-
         src => sources%get(sourceOffset)
+
         prm%kappa = src%get_asFloat('kappa')
         Nconstituents = count(material_phaseAt==p) * discretization_nIPs
-        call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,0,0,0)
+        call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,0,0,0)
 
         end associate
       endif
@@ -76,7 +78,7 @@ end function source_thermal_dissipation_init
 !--------------------------------------------------------------------------------------------------
 !> @brief Ninstancess dissipation rate
 !--------------------------------------------------------------------------------------------------
-module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT, Tstar, Lp, phase)
+module subroutine thermal_dissipation_getRate(TDot, Tstar, Lp, phase)
 
   integer, intent(in) :: &
     phase
@@ -86,14 +88,12 @@ module subroutine source_thermal_dissipation_getRateAndItsTangent(TDot, dTDot_dT
     Lp
 
   real(pReal),  intent(out) :: &
-    TDot, &
+    TDot
-    dTDot_dT
 
   associate(prm => param(source_thermal_dissipation_instance(phase)))
   TDot = prm%kappa*sum(abs(Tstar*Lp))
-  dTDot_dT = 0.0_pReal
   end associate
 
-end subroutine source_thermal_dissipation_getRateAndItsTangent
+end subroutine thermal_dissipation_getRate
 
-end submodule source_thermal_dissipation
+end submodule source_dissipation

src/constitutive_thermal_externalheat.f90

@@ -4,7 +4,7 @@
 !> @author Philip Eisenlohr, Michigan State University
 !> @brief material subroutine for variable heat source
 !--------------------------------------------------------------------------------------------------
-submodule(constitutive:constitutive_thermal) source_thermal_externalheat
+submodule(constitutive:constitutive_thermal) source_externalheat
 
 
   integer,           dimension(:),   allocatable :: &
@@ -37,13 +37,14 @@ module function source_thermal_externalheat_init(source_length) result(mySources
   class(tNode), pointer :: &
     phases, &
     phase, &
-    sources, &
+    sources, thermal, &
     src
   integer :: Ninstances,sourceOffset,Nconstituents,p
 
-  print'(/,a)', ' <<<+-  source_thermal_externalHeat init  -+>>>'
+  print'(/,a)', ' <<<+-  thermal_externalheat init  -+>>>'
+
+  mySources = thermal_active('externalheat',source_length)
 
-  mySources = source_active('thermal_externalheat',source_length)
   Ninstances = count(mySources)
   print'(a,i2)', ' # instances: ',Ninstances; flush(IO_STDOUT)
   if(Ninstances == 0) return
@@ -57,7 +58,8 @@ module function source_thermal_externalheat_init(source_length) result(mySources
     phase => phases%get(p)
     if(any(mySources(:,p))) source_thermal_externalheat_instance(p) = count(mySources(:,1:p))
     if(count(mySources(:,p)) == 0) cycle
-    sources => phase%get('source')
+    thermal => phase%get('thermal')
+    sources => thermal%get('source')
     do sourceOffset = 1, sources%length
       if(mySources(sourceOffset,p)) then
         source_thermal_externalheat_offset(p) = sourceOffset
@@ -70,9 +72,8 @@ module function source_thermal_externalheat_init(source_length) result(mySources
         prm%f_T = src%get_asFloats('f_T',requiredSize = size(prm%t_n))
 
         Nconstituents = count(material_phaseAt==p) * discretization_nIPs
-        call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0)
+        call constitutive_allocateState(thermalState(p)%p(sourceOffset),Nconstituents,1,1,0)
         end associate
-
       endif
     enddo
   enddo
@@ -95,7 +96,7 @@ module subroutine source_thermal_externalheat_dotState(phase, of)
 
   sourceOffset = source_thermal_externalheat_offset(phase)
 
-  sourceState(phase)%p(sourceOffset)%dotState(1,of) = 1.0_pReal                                     ! state is current time
+  thermalState(phase)%p(sourceOffset)%dotState(1,of) = 1.0_pReal                                     ! state is current time
 
 end subroutine source_thermal_externalheat_dotState
 
@@ -103,14 +104,13 @@ end subroutine source_thermal_externalheat_dotState
 !--------------------------------------------------------------------------------------------------
 !> @brief returns local heat generation rate
 !--------------------------------------------------------------------------------------------------
-module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of)
+module subroutine thermal_externalheat_getRate(TDot, phase, of)
 
   integer, intent(in) :: &
     phase, &
     of
   real(pReal),  intent(out) :: &
-    TDot, &
+    TDot
-    dTDot_dT
 
   integer :: &
     sourceOffset, interval
@@ -121,7 +121,7 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d
 
   associate(prm => param(source_thermal_externalheat_instance(phase)))
   do interval = 1, prm%nIntervals                                                                   ! scan through all rate segments
-    frac_time = (sourceState(phase)%p(sourceOffset)%state(1,of) - prm%t_n(interval)) &
+    frac_time = (thermalState(phase)%p(sourceOffset)%state(1,of) - prm%t_n(interval)) &
               / (prm%t_n(interval+1) - prm%t_n(interval))                                           ! fractional time within segment
     if (     (frac_time <  0.0_pReal .and. interval == 1) &
         .or. (frac_time >= 1.0_pReal .and. interval == prm%nIntervals) &
@@ -130,9 +130,8 @@ module subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_d
              prm%f_T(interval+1) * frac_time                                                        ! interpolate heat rate between segment boundaries...
                                                                                                     ! ...or extrapolate if outside of bounds
   enddo
-  dTDot_dT = 0.0
   end associate
 
-end subroutine source_thermal_externalheat_getRateAndItsTangent
+end subroutine thermal_externalheat_getRate
 
-end submodule source_thermal_externalheat
+end submodule source_externalheat

src/damage_local.f90

@@ -1,175 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for locally evolving damage field
-!--------------------------------------------------------------------------------------------------
-module damage_local
-  use prec
-  use IO
-  use material
-  use config
-  use YAML_types
-  use constitutive
-  use results
-
-  implicit none
-  private
-
-  type :: tParameters
-    character(len=pStringLen), allocatable, dimension(:) :: &
-      output
-  end type tParameters
-
-  type, private :: tNumerics
-    real(pReal) :: &
-      residualStiffness                                                                             !< non-zero residual damage
-  end type tNumerics
-
-  type(tparameters),             dimension(:),   allocatable :: &
-    param
-
-  type(tNumerics), private :: num  
-
-  public :: &
-    damage_local_init, &
-    damage_local_updateState, &
-    damage_local_results
-
-contains
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine damage_local_init
-
-  integer :: Ninstances,Nmaterialpoints,h
-  class(tNode), pointer :: &
-    num_generic, &
-    material_homogenization, &
-    homog, &
-    homogDamage
-
-  print'(/,a)', ' <<<+-  damage_local init  -+>>>'; flush(IO_STDOUT)
-
-!----------------------------------------------------------------------------------------------
-! read numerics parameter and do sanity check
-  num_generic => config_numerics%get('generic',defaultVal=emptyDict)
-  num%residualStiffness = num_generic%get_asFloat('residualStiffness', defaultVal=1.0e-6_pReal)
-  if (num%residualStiffness < 0.0_pReal)   call IO_error(301,ext_msg='residualStiffness')
-
-  Ninstances = count(damage_type == DAMAGE_local_ID)
-  allocate(param(Ninstances))
-
-  material_homogenization => config_material%get('homogenization')
-  do h = 1, material_homogenization%length
-    if (damage_type(h) /= DAMAGE_LOCAL_ID) cycle
-    homog => material_homogenization%get(h)
-    homogDamage => homog%get('damage')
-    associate(prm => param(damage_typeInstance(h)))
-
-#if defined (__GFORTRAN__)
-    prm%output = output_asStrings(homogDamage)
-#else
-    prm%output = homogDamage%get_asStrings('output',defaultVal=emptyStringArray)
-#endif
-
-    Nmaterialpoints = count(material_homogenizationAt == h)
-    damageState(h)%sizeState = 1
-    allocate(damageState(h)%state0   (1,Nmaterialpoints), source=damage_initialPhi(h))
-    allocate(damageState(h)%subState0(1,Nmaterialpoints), source=damage_initialPhi(h))
-    allocate(damageState(h)%state    (1,Nmaterialpoints), source=damage_initialPhi(h))
-
-    nullify(damageMapping(h)%p)
-    damageMapping(h)%p => material_homogenizationMemberAt
-    deallocate(damage(h)%p)
-    damage(h)%p => damageState(h)%state(1,:)
-
-    end associate
-  enddo
-
-end subroutine damage_local_init
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  calculates local change in damage field
-!--------------------------------------------------------------------------------------------------
-function damage_local_updateState(subdt, ip, el)
-
-  integer, intent(in) :: &
-    ip, &                                                                                           !< integration point number
-    el                                                                                              !< element number
-  real(pReal),   intent(in) :: &
-    subdt
-  logical,    dimension(2)  :: &
-    damage_local_updateState
-  integer :: &
-    homog, &
-    offset
-  real(pReal) :: &
-    phi, phiDot, dPhiDot_dPhi
-
-  homog  = material_homogenizationAt(el)
-  offset = material_homogenizationMemberAt(ip,el)
-  phi = damageState(homog)%subState0(1,offset)
-  call damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
-  phi = max(num%residualStiffness,min(1.0_pReal,phi + subdt*phiDot))
-
-  damage_local_updateState = [     abs(phi - damageState(homog)%state(1,offset)) &
-                                <= 1.0e-2_pReal &
-                              .or. abs(phi - damageState(homog)%state(1,offset)) &
-                                <= 1.0e-6_pReal*abs(damageState(homog)%state(1,offset)), &
-                              .true.]
-
-  damageState(homog)%state(1,offset) = phi
-
-end function damage_local_updateState
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  calculates homogenized local damage driving forces
-!--------------------------------------------------------------------------------------------------
-subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
-
-  integer, intent(in) :: &
-    ip, &                                                                                           !< integration point number
-    el                                                                                              !< element number
-  real(pReal),   intent(in) :: &
-    phi
-  real(pReal) :: &
-    phiDot, dPhiDot_dPhi
-
-  phiDot = 0.0_pReal
-  dPhiDot_dPhi = 0.0_pReal
- 
-  call constitutive_damage_getRateAndItsTangents(phiDot, dPhiDot_dPhi, phi, ip, el)
-
-  phiDot = phiDot/real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal)
-  dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal)
-
-end subroutine damage_local_getSourceAndItsTangent
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief writes results to HDF5 output file
-!--------------------------------------------------------------------------------------------------
-subroutine damage_local_results(homog,group)
-
-  integer,          intent(in) :: homog
-  character(len=*), intent(in) :: group
-
-  integer :: o
-
-  associate(prm => param(damage_typeInstance(homog)))
-  outputsLoop: do o = 1,size(prm%output)
-    select case(prm%output(o))
-      case ('phi')
-        call results_writeDataset(group,damage(homog)%p,prm%output(o),&
-                                  'damage indicator','-')
-    end select
-  enddo outputsLoop
-  end associate
-
-end subroutine damage_local_results
-
-
-end module damage_local

src/damage_none.f90

@@ -3,6 +3,7 @@
 !> @brief material subroutine for constant damage field
 !--------------------------------------------------------------------------------------------------
 module damage_none
+  use prec
   use config
   use material
 
@@ -24,13 +25,12 @@ subroutine damage_none_init
     if (damage_type(h) /= DAMAGE_NONE_ID) cycle
 
     Nmaterialpoints = count(material_homogenizationAt == h)
-    damageState(h)%sizeState = 0
+    damageState_h(h)%sizeState = 0
-    allocate(damageState(h)%state0   (0,Nmaterialpoints))
+    allocate(damageState_h(h)%state0   (0,Nmaterialpoints))
-    allocate(damageState(h)%subState0(0,Nmaterialpoints))
+    allocate(damageState_h(h)%subState0(0,Nmaterialpoints))
-    allocate(damageState(h)%state    (0,Nmaterialpoints))
+    allocate(damageState_h(h)%state    (0,Nmaterialpoints))
 
-    deallocate(damage(h)%p)
+    allocate  (damage(h)%p(Nmaterialpoints), source=1.0_pReal)
-    allocate  (damage(h)%p(1), source=damage_initialPhi(h))
 
   enddo
 

src/damage_nonlocal.f90

@@ -7,7 +7,6 @@ module damage_nonlocal
   use material
   use config
   use YAML_types
-  use crystallite
   use lattice
   use constitutive
   use results
@@ -77,15 +76,12 @@ subroutine damage_nonlocal_init
 #endif
 
     Nmaterialpoints = count(material_homogenizationAt == h)
-    damageState(h)%sizeState = 1
+    damageState_h(h)%sizeState = 1
-    allocate(damageState(h)%state0   (1,Nmaterialpoints), source=damage_initialPhi(h))
+    allocate(damageState_h(h)%state0   (1,Nmaterialpoints), source=1.0_pReal)
-    allocate(damageState(h)%subState0(1,Nmaterialpoints), source=damage_initialPhi(h))
+    allocate(damageState_h(h)%subState0(1,Nmaterialpoints), source=1.0_pReal)
-    allocate(damageState(h)%state    (1,Nmaterialpoints), source=damage_initialPhi(h))
+    allocate(damageState_h(h)%state    (1,Nmaterialpoints), source=1.0_pReal)
 
-    nullify(damageMapping(h)%p)
+    damage(h)%p => damageState_h(h)%state(1,:)
-    damageMapping(h)%p => material_homogenizationMemberAt
-    deallocate(damage(h)%p)
-    damage(h)%p => damageState(h)%state(1,:)
 
     end associate
   enddo
@@ -152,12 +148,12 @@ real(pReal) function damage_nonlocal_getMobility(ip,el)
     ip, &                                                                                           !< integration point number
     el                                                                                              !< element number
   integer :: &
-    ipc
+    co
 
   damage_nonlocal_getMobility = 0.0_pReal
 
-  do ipc = 1, homogenization_Nconstituents(material_homogenizationAt(el))
+  do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
-    damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_M(material_phaseAt(ipc,el))
+    damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_M(material_phaseAt(co,el))
   enddo
 
   damage_nonlocal_getMobility = damage_nonlocal_getMobility/&
@@ -181,7 +177,7 @@ subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el)
     offset
 
   homog  = material_homogenizationAt(el)
-  offset = damageMapping(homog)%p(ip,el)
+  offset = material_homogenizationMemberAt(ip,el)
   damage(homog)%p(offset) = phi
 
 end subroutine damage_nonlocal_putNonLocalDamage

src/grid/DAMASK_grid.f90

@@ -42,8 +42,8 @@ program DAMASK_grid
 
 !--------------------------------------------------------------------------------------------------
 ! variables related to information from load case and geom file
-  real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal                                         !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
+  real(pReal), dimension(9) :: temp_valueVector                                                     !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
-  logical,     dimension(9) :: temp_maskVector  = .false.                                           !< temporarily from loadcase file when reading in tensors
+  logical,     dimension(9) :: temp_maskVector                                                      !< temporarily from loadcase file when reading in tensors
 
 !--------------------------------------------------------------------------------------------------
 ! loop variables, convergence etc.
@@ -145,8 +145,6 @@ program DAMASK_grid
       mech_restartWrite => grid_mech_spectral_basic_restartWrite
 
     case ('Polarisation')
-     if(debug_grid%contains('basic')) &
-        call IO_warning(42, ext_msg='debug Divergence')
       mech_init         => grid_mech_spectral_polarisation_init
       mech_forward      => grid_mech_spectral_polarisation_forward
       mech_solution     => grid_mech_spectral_polarisation_solution
@@ -154,8 +152,6 @@ program DAMASK_grid
       mech_restartWrite => grid_mech_spectral_polarisation_restartWrite
 
     case ('FEM')
-     if(debug_grid%contains('basic')) &
-        call IO_warning(42, ext_msg='debug Divergence')
       mech_init         => grid_mech_FEM_init
       mech_forward      => grid_mech_FEM_forward
       mech_solution     => grid_mech_FEM_solution
@@ -180,11 +176,11 @@ program DAMASK_grid
     allocate(loadCases(l)%ID(nActiveFields))
     field = 1
     loadCases(l)%ID(field) = FIELD_MECH_ID                                                          ! mechanical active by default
-    thermalActive: if (any(thermal_type  == THERMAL_conduction_ID)) then
+    thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then
       field = field + 1
       loadCases(l)%ID(field) = FIELD_THERMAL_ID
     endif thermalActive
-    damageActive: if (any(damage_type   == DAMAGE_nonlocal_ID)) then
+    damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then
       field = field + 1
       loadCases(l)%ID(field) = FIELD_DAMAGE_ID
     endif damageActive
@@ -192,33 +188,35 @@ program DAMASK_grid
     load_step => load_steps%get(l)
 
     step_mech => load_step%get('mechanics')
-    loadCases(l)%stress%myType='P'
+    loadCases(l)%stress%myType=''
     readMech: do m = 1, step_mech%length
       select case (step_mech%getKey(m))
-        case('dot_F','L','F')                                                                       ! assign values for the deformation BC matrix
+        case ('L','dot_F','F')                                                                      ! assign values for the deformation BC matrix
           loadCases(l)%deformation%myType = step_mech%getKey(m)
-          temp_valueVector = 0.0_pReal
-
           step_deformation => step_mech%get(m)
-          do j = 1, 9
+
-            temp_maskVector(j) = step_deformation%get_asString(j) /= 'x'                            ! true if not a 'x'
-            if (temp_maskVector(j)) temp_valueVector(j) = step_deformation%get_asFloat(j)           ! read value where applicable
-          enddo
-          loadCases(l)%deformation%mask   = transpose(reshape(temp_maskVector,[ 3,3]))              ! mask in 3x3 notation
-          loadCases(l)%deformation%values = math_9to33(temp_valueVector)                            ! values in 3x3 notation
-        case('P')
           temp_valueVector = 0.0_pReal
-          step_stress => step_mech%get(m)
           do j = 1, 9
-            temp_maskVector(j) = step_stress%get_asString(j) /= 'x'                                 ! true if not a 'x'
+            temp_maskVector(j) = step_deformation%get_asString(j) /= 'x'
-            if (temp_maskVector(j)) temp_valueVector(j) = step_stress%get_asFloat(j)                ! read value where applicable
+            if (temp_maskVector(j)) temp_valueVector(j) = step_deformation%get_asFloat(j)
           enddo
-          loadCases(l)%stress%mask   = transpose(reshape(temp_maskVector,[ 3,3]))
+          loadCases(l)%deformation%mask   = transpose(reshape(temp_maskVector,[3,3]))
+          loadCases(l)%deformation%values = math_9to33(temp_valueVector)
+        case ('dot_P','P')
+          loadCases(l)%stress%myType = step_mech%getKey(m)
+          step_stress => step_mech%get(m)
+
+          temp_valueVector = 0.0_pReal
+          do j = 1, 9
+            temp_maskVector(j) = step_stress%get_asString(j) /= 'x'
+            if (temp_maskVector(j)) temp_valueVector(j) = step_stress%get_asFloat(j)
+          enddo
+          loadCases(l)%stress%mask   = transpose(reshape(temp_maskVector,[3,3]))
           loadCases(l)%stress%values = math_9to33(temp_valueVector)
       end select
       call loadCases(l)%rot%fromAxisAngle(step_mech%get_asFloats('R',defaultVal = real([0.0,0.0,1.0,0.0],pReal)),degrees=.true.)
     enddo readMech
-    if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/F/dot_F missing')
+    if (.not. allocated(loadCases(l)%deformation%myType)) call IO_error(error_ID=837,ext_msg = 'L/dot_F/F missing')
 
     step_discretization => load_step%get('discretization')
     if(.not. step_discretization%contains('t')) call IO_error(error_ID=837,ext_msg = 't missing')
@@ -241,50 +239,60 @@ program DAMASK_grid
           if (any(loadCases(l)%deformation%mask(j,1:3) .eqv. .true.) .and. &
               any(loadCases(l)%deformation%mask(j,1:3) .eqv. .false.)) errorID = 832                ! each row should be either fully or not at all defined
         enddo
-        print*, ' L:'
+      endif
-      else if (loadCases(l)%deformation%myType == 'F') then
+      if (loadCases(l)%deformation%myType == 'F') then
         print*, ' F:'
-      else if (loadCases(l)%deformation%myType == 'dot_F') then
+      else
-        print*, ' dot_F:'
+        print*, ' '//loadCases(l)%deformation%myType//' / 1/s:'
       endif
       do i = 1, 3; do j = 1, 3
-        if(loadCases(l)%deformation%mask(i,j)) then
+        if (loadCases(l)%deformation%mask(i,j)) then
           write(IO_STDOUT,'(2x,f12.7)',advance='no') loadCases(l)%deformation%values(i,j)
-        else
-          write(IO_STDOUT,'(2x,12a)',advance='no') '     x      '
-          endif
-        enddo; write(IO_STDOUT,'(/)',advance='no')
-      enddo
-      if (any(loadCases(l)%stress%mask .eqv. loadCases(l)%deformation%mask)) errorID = 831          ! exclusive or masking only
-      if (any(loadCases(l)%stress%mask .and. transpose(loadCases(l)%stress%mask) .and. (math_I3<1))) &
-        errorID = 838                                                                               ! no rotation is allowed by stress BC
-      print*, ' P / MPa:'
-      do i = 1, 3; do j = 1, 3
-        if(loadCases(l)%stress%mask(i,j)) then
-          write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pReal
         else
           write(IO_STDOUT,'(2x,12a)',advance='no') '     x      '
         endif
         enddo; write(IO_STDOUT,'(/)',advance='no')
       enddo
+      if (any(loadCases(l)%stress%mask .eqv. loadCases(l)%deformation%mask)) errorID = 831
+      if (any(loadCases(l)%stress%mask .and. transpose(loadCases(l)%stress%mask) .and. (math_I3<1))) &
+        errorID = 838                                                                               ! no rotation is allowed by stress BC
+
+      if (loadCases(l)%stress%myType == 'P')     print*, ' P / MPa:'
+      if (loadCases(l)%stress%myType == 'dot_P') print*, ' dot_P / MPa/s:'
+
+      if (loadCases(l)%stress%myType /= '') then
+        do i = 1, 3; do j = 1, 3
+          if (loadCases(l)%stress%mask(i,j)) then
+            write(IO_STDOUT,'(2x,f12.4)',advance='no') loadCases(l)%stress%values(i,j)*1e-6_pReal
+          else
+            write(IO_STDOUT,'(2x,12a)',advance='no') '     x      '
+          endif
+          enddo; write(IO_STDOUT,'(/)',advance='no')
+        enddo
+      endif
       if (any(dNeq(loadCases(l)%rot%asMatrix(), math_I3))) &
         write(IO_STDOUT,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'R:',&
                  transpose(loadCases(l)%rot%asMatrix())
 
-      if (loadCases(l)%t < 0.0_pReal) errorID = 834
+      if (loadCases(l)%r <= 0.0)       errorID = 833
-      print'(a,f0.3)', '  t: ', loadCases(l)%t
+      if (loadCases(l)%t < 0.0_pReal)  errorID = 834
-      if (loadCases(l)%N < 1)    errorID = 835
+      if (loadCases(l)%N < 1)          errorID = 835
-      print'(a,i0)',   '  N: ', loadCases(l)%N
+      if (loadCases(l)%f_out < 1)      errorID = 836
-      if (loadCases(l)%f_out < 1)  errorID = 836
-      print'(a,i0)',   '  f_out: ', loadCases(l)%f_out
-      if (loadCases(l)%r <= 0.0)  errorID = 833
-      print'(a,f0.3)', '  r: ', loadCases(l)%r
-
       if (loadCases(l)%f_restart < 1)  errorID = 839
+
+      if (dEq(loadCases(l)%r,1.0_pReal,1.e-9_pReal)) then
+        print'(a)', '  r: 1 (constant step widths)'
+      else
+        print'(a,f0.3)', '  r: ', loadCases(l)%r
+      endif
+      print'(a,f0.3)', '  t: ', loadCases(l)%t
+      print'(a,i0)',   '  N: ', loadCases(l)%N
+      print'(a,i0)',   '  f_out: ', loadCases(l)%f_out
       if (loadCases(l)%f_restart < huge(0)) &
         print'(a,i0)', '  f_restart: ', loadCases(l)%f_restart
 
       if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string)                 ! exit with error message
+
     endif reportAndCheck
   enddo
 
@@ -311,8 +319,6 @@ program DAMASK_grid
     writeHeader: if (interface_restartInc < 1) then
       open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
       write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded'                ! statistics file
-      if (debug_grid%contains('basic')) print'(/,a)', ' header of statistics file written out'
-      flush(IO_STDOUT)
     else writeHeader
       open(newunit=statUnit,file=trim(getSolverJobName())//&
                                   '.sta',form='FORMATTED', position='APPEND', status='OLD')
@@ -321,6 +327,7 @@ program DAMASK_grid
 
   writeUndeformed: if (interface_restartInc < 1) then
     print'(/,a)', ' ... writing initial configuration to file ........................'
+    flush(IO_STDOUT)
     call CPFEM_results(0,0.0_pReal)
   endif writeUndeformed
 

src/grid/discretization_grid.f90

@@ -19,7 +19,6 @@ module discretization_grid
   use results
   use discretization
   use geometry_plastic_nonlocal
-  use FEsolving
 
   implicit none
   private
@@ -117,9 +116,6 @@ subroutine discretization_grid_init(restart)
                                  (grid(1)+1) * (grid(2)+1) *  grid3,&                               ! ...unless not last process
                                  worldrank+1==worldsize))
 
-  FEsolving_execElem = [1,product(myGrid)]                                                          ! parallel loop bounds set to comprise all elements
-  FEsolving_execIP   = [1,1]                                                                        ! parallel loop bounds set to comprise the only IP
-
 !--------------------------------------------------------------------------------------------------
 ! store geometry information for post processing
   if(.not. restart) then

src/grid/grid_damage_spectral.f90

@@ -203,8 +203,7 @@ function grid_damage_spectral_solution(timeinc) result(solution)
   call VecMax(solution_vec,devNull,phi_max,ierr); CHKERRQ(ierr)
   if (solution%converged) &
     print'(/,a)', ' ... nonlocal damage converged .....................................'
-  write(IO_STDOUT,'(/,a,f8.6,2x,f8.6,2x,e11.4,/)',advance='no') ' Minimum|Maximum|Delta Damage      = ',&
+  print'(/,a,f8.6,2x,f8.6,2x,e11.4)', ' Minimum|Maximum|Delta Damage      = ', phi_min, phi_max, stagNorm
-                                                          phi_min, phi_max, stagNorm
   print'(/,a)', ' ==========================================================================='
   flush(IO_STDOUT) 
 

src/grid/grid_mech_FEM.f90

@@ -18,7 +18,6 @@ module grid_mech_FEM
   use math
   use rotations
   use spectral_utilities
-  use FEsolving
   use config
   use homogenization
   use discretization
@@ -31,16 +30,16 @@ module grid_mech_FEM
 
   type :: tNumerics
     integer :: &
-      itmin, &                                                                                        !< minimum number of iterations
+      itmin, &                                                                                      !< minimum number of iterations
-      itmax                                                                                           !< maximum number of iterations
+      itmax                                                                                         !< maximum number of iterations
     real(pReal) :: &
-      eps_div_atol, &                                                                                 !< absolute tolerance for equilibrium
+      eps_div_atol, &                                                                               !< absolute tolerance for equilibrium
-      eps_div_rtol, &                                                                                 !< relative tolerance for equilibrium
+      eps_div_rtol, &                                                                               !< relative tolerance for equilibrium
-      eps_stress_atol, &                                                                              !< absolute tolerance for fullfillment of stress BC
+      eps_stress_atol, &                                                                            !< absolute tolerance for fullfillment of stress BC
-      eps_stress_rtol                                                                                 !< relative tolerance for fullfillment of stress BC
+      eps_stress_rtol                                                                               !< relative tolerance for fullfillment of stress BC
   end type tNumerics
 
-  type(tNumerics) :: num                                                                              ! numerics parameters. Better name?
+  type(tNumerics) :: num                                                                            ! numerics parameters. Better name?
 
   logical :: debugRotation
 
@@ -64,7 +63,7 @@ module grid_mech_FEM
   real(pReal), dimension(3,3) :: &
     F_aimDot = 0.0_pReal, &                                                                         !< assumed rate of average deformation gradient
     F_aim = math_I3, &                                                                              !< current prescribed deformation gradient
-    F_aim_lastInc  = math_I3, &                                                                     !< previous average deformation gradient
+    F_aim_lastInc = math_I3, &                                                                      !< previous average deformation gradient
     P_av = 0.0_pReal, &                                                                             !< average 1st Piola--Kirchhoff stress
     P_aim = 0.0_pReal
   character(len=:), allocatable :: incInfo                                                          !< time and increment information
@@ -93,10 +92,8 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine grid_mech_FEM_init
 
-  real(pReal) :: HGCoeff = 0.0e-2_pReal
+  real(pReal), parameter :: HGCoeff = 0.0e-2_pReal
-  real(pReal), dimension(3,3) :: &
+  real(pReal), parameter, dimension(4,8) :: &
-    temp33_Real = 0.0_pReal
-  real(pReal), dimension(4,8) :: &
     HGcomp = reshape([ 1.0_pReal, 1.0_pReal, 1.0_pReal,-1.0_pReal, &
                        1.0_pReal,-1.0_pReal,-1.0_pReal, 1.0_pReal, &
                       -1.0_pReal, 1.0_pReal,-1.0_pReal, 1.0_pReal, &
@@ -121,18 +118,19 @@ subroutine grid_mech_FEM_init
 
 !-------------------------------------------------------------------------------------------------
 ! debugging options
-  debug_grid => config_debug%get('grid', defaultVal=emptyList)
+  debug_grid => config_debug%get('grid',defaultVal=emptyList)
   debugRotation = debug_grid%contains('rotation')
 
 !-------------------------------------------------------------------------------------------------
 ! read numerical parameters and do sanity checks
   num_grid => config_numerics%get('grid',defaultVal=emptyDict)
+
   num%eps_div_atol    = num_grid%get_asFloat('eps_div_atol',   defaultVal=1.0e-4_pReal)
   num%eps_div_rtol    = num_grid%get_asFloat('eps_div_rtol',   defaultVal=5.0e-4_pReal)
   num%eps_stress_atol = num_grid%get_asFloat('eps_stress_atol',defaultVal=1.0e3_pReal)
   num%eps_stress_rtol = num_grid%get_asFloat('eps_stress_rtol',defaultVal=1.0e-3_pReal)
-  num%itmin           = num_grid%get_asInt  ('itmin',          defaultVal=1)
+  num%itmin           = num_grid%get_asInt  ('itmin',defaultVal=1)
-  num%itmax           = num_grid%get_asInt  ('itmax',          defaultVal=250)
+  num%itmax           = num_grid%get_asInt  ('itmax',defaultVal=250)
 
   if (num%eps_div_atol <= 0.0_pReal)             call IO_error(301,ext_msg='eps_div_atol')
   if (num%eps_div_rtol < 0.0_pReal)              call IO_error(301,ext_msg='eps_div_rtol')
@@ -225,6 +223,7 @@ subroutine grid_mech_FEM_init
     fileHandle  = HDF5_openFile(fileName)
     groupHandle = HDF5_openGroup(fileHandle,'solver')
 
+    call HDF5_read(groupHandle,P_aim,        'P_aim')
     call HDF5_read(groupHandle,F_aim,        'F_aim')
     call HDF5_read(groupHandle,F_aim_lastInc,'F_aim_lastInc')
     call HDF5_read(groupHandle,F_aimDot,     'F_aimDot')
@@ -238,9 +237,9 @@ subroutine grid_mech_FEM_init
     F         = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3)
   endif restartRead
 
-  homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3])                           ! set starting condition for materialpoint_stressAndItsTangent
+  homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3])                            ! set starting condition for materialpoint_stressAndItsTangent
   call utilities_updateCoords(F)
-  call utilities_constitutiveResponse(P_current,temp33_Real,C_volAvg,devNull, &                     ! stress field, stress avg, global average of stiffness and (min+max)/2
+  call utilities_constitutiveResponse(P_current,P_av,C_volAvg,devNull, &                            ! stress field, stress avg, global average of stiffness and (min+max)/2
                                       F, &                                                          ! target F
                                       0.0_pReal)                                                    ! time increment
   call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr)
@@ -295,6 +294,7 @@ function grid_mech_FEM_solution(incInfoIn) result(solution)
   solution%iterationsNeeded = totalIter
   solution%termIll = terminallyIll
   terminallyIll = .false.
+  P_aim = merge(P_aim,P_av,params%stress_mask)
 
 end function grid_mech_FEM_solution
 
@@ -302,34 +302,26 @@ end function grid_mech_FEM_solution
 !--------------------------------------------------------------------------------------------------
 !> @brief forwarding routine
 !> @details find new boundary conditions and best F estimate for end of current timestep
-!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
 !--------------------------------------------------------------------------------------------------
-subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,&
+subroutine grid_mech_FEM_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,&
                                  deformation_BC,stress_BC,rotation_BC)
 
-  logical,                     intent(in) :: &
+  logical,                  intent(in) :: &
     cutBack, &
     guess
-  real(pReal),                 intent(in) :: &
+  real(pReal),              intent(in) :: &
-    timeinc_old, &
+    Delta_t_old, &
-    timeinc, &
+    Delta_t, &
-    loadCaseTime                                                                                    !< remaining time of current load case
+    t_remaining                                                                                     !< remaining time of current load case
-  type(tBoundaryCondition),    intent(in) :: &
+  type(tBoundaryCondition), intent(in) :: &
     stress_BC, &
     deformation_BC
-  type(rotation),              intent(in) :: &
+  type(rotation),           intent(in) :: &
     rotation_BC
   PetscErrorCode :: ierr
   PetscScalar, pointer, dimension(:,:,:,:) :: &
     u_current,u_lastInc
 
-!--------------------------------------------------------------------------------------------------
-! set module wide available data
-  params%stress_mask = stress_BC%mask
-  params%rotation_BC = rotation_BC
-  params%timeinc     = timeinc
-  params%timeincOld  = timeinc_old
-
 
   call DMDAVecGetArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr)
   call DMDAVecGetArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr)
@@ -339,7 +331,7 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,
   else
     C_volAvgLastInc    = C_volAvg
 
-    F_aimDot = merge(merge((F_aim-F_aim_lastInc)/timeinc_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess)
+    F_aimDot = merge(merge((F_aim-F_aim_lastInc)/Delta_t_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess)  ! estimate deformation rate for prescribed stress components
     F_aim_lastInc = F_aim
 
     !-----------------------------------------------------------------------------------------------
@@ -347,18 +339,18 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,
     if     (deformation_BC%myType=='L') then                                                        ! calculate F_aimDot from given L and current F
       F_aimDot = F_aimDot &
                + merge(matmul(deformation_BC%values, F_aim_lastInc),.0_pReal,deformation_BC%mask)
-    elseif(deformation_BC%myType=='dot_F') then                                                     ! F_aimDot is prescribed
+    elseif (deformation_BC%myType=='dot_F') then                                                    ! F_aimDot is prescribed
       F_aimDot = F_aimDot &
                + merge(deformation_BC%values,.0_pReal,deformation_BC%mask)
     elseif (deformation_BC%myType=='F') then                                                        ! aim at end of load case is prescribed
       F_aimDot = F_aimDot &
-               + merge((deformation_BC%values - F_aim_lastInc)/loadCaseTime,.0_pReal,deformation_BC%mask)
+               + merge((deformation_BC%values - F_aim_lastInc)/t_remaining,.0_pReal,deformation_BC%mask)
     endif
 
     if (guess) then
       call VecWAXPY(solution_rate,-1.0_pReal,solution_lastInc,solution_current,ierr)
       CHKERRQ(ierr)
-      call VecScale(solution_rate,1.0_pReal/timeinc_old,ierr); CHKERRQ(ierr)
+      call VecScale(solution_rate,1.0_pReal/Delta_t_old,ierr); CHKERRQ(ierr)
     else
       call VecSet(solution_rate,0.0_pReal,ierr); CHKERRQ(ierr)
     endif
@@ -366,28 +358,33 @@ subroutine grid_mech_FEM_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,
 
     F_lastInc = F
 
-    homogenization_F0 = reshape(F, [3,3,1,product(grid(1:2))*grid3])
+    homogenization_F0 = reshape(F, [3,3,product(grid(1:2))*grid3])
   endif
 
 !--------------------------------------------------------------------------------------------------
 ! update average and local deformation gradients
-  F_aim = F_aim_lastInc + F_aimDot * timeinc
+  F_aim = F_aim_lastInc + F_aimDot * Delta_t
-  if     (stress_BC%myType=='P') then
+  if (stress_BC%myType=='P')     P_aim = P_aim &
-    P_aim = P_aim + merge((stress_BC%values - P_aim)/loadCaseTime*timeinc,.0_pReal,stress_BC%mask)
+                                       + merge((stress_BC%values - P_aim)/t_remaining,0.0_pReal,stress_BC%mask)*Delta_t
-  elseif (stress_BC%myType=='dot_P') then !UNTESTED
+  if (stress_BC%myType=='dot_P') P_aim = P_aim &
-    P_aim = P_aim + merge(stress_BC%values*timeinc,.0_pReal,stress_BC%mask)
+                                       + merge(stress_BC%values,0.0_pReal,stress_BC%mask)*Delta_t
-  endif
 
-  call VecAXPY(solution_current,timeinc,solution_rate,ierr); CHKERRQ(ierr)
+  call VecAXPY(solution_current,Delta_t,solution_rate,ierr); CHKERRQ(ierr)
 
-  call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr);CHKERRQ(ierr)
+  call DMDAVecRestoreArrayF90(mech_grid,solution_current,u_current,ierr); CHKERRQ(ierr)
-  call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr);CHKERRQ(ierr)
+  call DMDAVecRestoreArrayF90(mech_grid,solution_lastInc,u_lastInc,ierr); CHKERRQ(ierr)
+
+!--------------------------------------------------------------------------------------------------
+! set module wide available data
+  params%stress_mask = stress_BC%mask
+  params%rotation_BC = rotation_BC
+  params%timeinc     = Delta_t
 
 end subroutine grid_mech_FEM_forward
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Age
+!> @brief Update coordinates
 !--------------------------------------------------------------------------------------------------
 subroutine grid_mech_FEM_updateCoords
 
@@ -415,6 +412,7 @@ subroutine grid_mech_FEM_restartWrite
   fileHandle  = HDF5_openFile(fileName,'w')
   groupHandle = HDF5_addGroup(fileHandle,'solver')
 
+  call HDF5_write(groupHandle,P_aim,        'P_aim')
   call HDF5_write(groupHandle,F_aim,        'F_aim')
   call HDF5_write(groupHandle,F_aim_lastInc,'F_aim_lastInc')
   call HDF5_write(groupHandle,F_aimDot,     'F_aimDot')
@@ -441,11 +439,11 @@ end subroutine grid_mech_FEM_restartWrite
 subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,ierr)
 
   SNES :: snes_local
-   PetscInt,  intent(in) :: PETScIter
+  PetscInt,  intent(in) :: PETScIter
-   PetscReal, intent(in) :: &
+  PetscReal, intent(in) :: &
-     devNull1, &
+    devNull1, &
-     devNull2, &
+    devNull2, &
-     fnorm
+    fnorm
   SNESConvergedReason :: reason
   PetscObject :: dummy
   PetscErrorCode :: ierr
@@ -458,10 +456,10 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,i
   divTol = max(maxval(abs(P_av))*num%eps_div_rtol   ,num%eps_div_atol)
   BCTol  = max(maxval(abs(P_av))*num%eps_stress_rtol,num%eps_stress_atol)
 
-  if ((totalIter >= num%itmin .and. &
+  if (terminallyIll .or. &
-                            all([ err_div/divTol, &
+      (totalIter >= num%itmin .and. &
-                                  err_BC /BCTol       ] < 1.0_pReal)) &
+       all([ err_div/divTol, &
-              .or.    terminallyIll) then
+             err_BC /BCTol   ] < 1.0_pReal))) then
     reason = 1
   elseif (totalIter >= num%itmax) then
     reason = -1
@@ -510,11 +508,10 @@ subroutine formResidual(da_local,x_local, &
   newIteration: if (totalIter <= PETScIter) then
     totalIter = totalIter + 1
     print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter+1, '≤', num%itmax
-    if (debugRotation) &
+    if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-      write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
+      ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
-              ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
+    print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-    write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
+      ' deformation gradient aim       =', transpose(F_aim)
-              ' deformation gradient aim       =', transpose(F_aim)
     flush(IO_STDOUT)
   endif newIteration
 
@@ -559,9 +556,9 @@ subroutine formResidual(da_local,x_local, &
     ii = i-xstart+1; jj = j-ystart+1; kk = k-zstart+1
     ele = ele + 1
     f_elem = matmul(transpose(BMat),transpose(P_current(1:3,1:3,ii,jj,kk)))*detJ + &
-             matmul(HGMat,x_elem)*(homogenization_dPdF(1,1,1,1,1,ele) + &
+             matmul(HGMat,x_elem)*(homogenization_dPdF(1,1,1,1,ele) + &
-                                   homogenization_dPdF(2,2,2,2,1,ele) + &
+                                   homogenization_dPdF(2,2,2,2,ele) + &
-                                   homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal
+                                   homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
     ctr = 0
     do kk = 0, 1; do jj = 0, 1; do ii = 0, 1
       ctr = ctr + 1
@@ -638,18 +635,18 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
     row = col
     ele = ele + 1
     K_ele = 0.0
-    K_ele(1 :8 ,1 :8 ) = HGMat*(homogenization_dPdF(1,1,1,1,1,ele) + &
+    K_ele(1 :8 ,1 :8 ) = HGMat*(homogenization_dPdF(1,1,1,1,ele) + &
-                                homogenization_dPdF(2,2,2,2,1,ele) + &
+                                homogenization_dPdF(2,2,2,2,ele) + &
-                                homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal
+                                homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
-    K_ele(9 :16,9 :16) = HGMat*(homogenization_dPdF(1,1,1,1,1,ele) + &
+    K_ele(9 :16,9 :16) = HGMat*(homogenization_dPdF(1,1,1,1,ele) + &
-                                homogenization_dPdF(2,2,2,2,1,ele) + &
+                                homogenization_dPdF(2,2,2,2,ele) + &
-                                homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal
+                                homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
-    K_ele(17:24,17:24) = HGMat*(homogenization_dPdF(1,1,1,1,1,ele) + &
+    K_ele(17:24,17:24) = HGMat*(homogenization_dPdF(1,1,1,1,ele) + &
-                                homogenization_dPdF(2,2,2,2,1,ele) + &
+                                homogenization_dPdF(2,2,2,2,ele) + &
-                                homogenization_dPdF(3,3,3,3,1,ele))/3.0_pReal
+                                homogenization_dPdF(3,3,3,3,ele))/3.0_pReal
     K_ele = K_ele + &
             matmul(transpose(BMatFull), &
-                   matmul(reshape(reshape(homogenization_dPdF(1:3,1:3,1:3,1:3,1,ele), &
+                   matmul(reshape(reshape(homogenization_dPdF(1:3,1:3,1:3,1:3,ele), &
                                           shape=[3,3,3,3], order=[2,1,4,3]),shape=[9,9]),BMatFull))*detJ
     call MatSetValuesStencil(Jac,24,row,24,col,K_ele,ADD_VALUES,ierr)
     CHKERRQ(ierr)
@@ -666,16 +663,16 @@ subroutine formJacobian(da_local,x_local,Jac_pre,Jac,dummy,ierr)
           C_volAvg(3,3,3,3)/delta(3)**2.0_pReal)*detJ
   call MatZeroRowsColumns(Jac,size(rows),rows,diag,PETSC_NULL_VEC,PETSC_NULL_VEC,ierr)
   CHKERRQ(ierr)
-  call DMGetGlobalVector(da_local,coordinates,ierr);CHKERRQ(ierr)
+  call DMGetGlobalVector(da_local,coordinates,ierr); CHKERRQ(ierr)
-  call DMDAVecGetArrayF90(da_local,coordinates,x_scal,ierr);CHKERRQ(ierr)
+  call DMDAVecGetArrayF90(da_local,coordinates,x_scal,ierr); CHKERRQ(ierr)
   ele = 0
   do k = zstart, zend; do j = ystart, yend; do i = xstart, xend
     ele = ele + 1
     x_scal(0:2,i,j,k) = discretization_IPcoords(1:3,ele)
   enddo; enddo; enddo
-  call DMDAVecRestoreArrayF90(da_local,coordinates,x_scal,ierr);CHKERRQ(ierr)                       ! initialize to undeformed coordinates (ToDo: use ip coordinates)
+  call DMDAVecRestoreArrayF90(da_local,coordinates,x_scal,ierr); CHKERRQ(ierr)                      ! initialize to undeformed coordinates (ToDo: use ip coordinates)
-  call MatNullSpaceCreateRigidBody(coordinates,matnull,ierr);CHKERRQ(ierr)                          ! get rigid body deformation modes
+  call MatNullSpaceCreateRigidBody(coordinates,matnull,ierr); CHKERRQ(ierr)                         ! get rigid body deformation modes
-  call DMRestoreGlobalVector(da_local,coordinates,ierr);CHKERRQ(ierr)
+  call DMRestoreGlobalVector(da_local,coordinates,ierr); CHKERRQ(ierr)
   call MatSetNullSpace(Jac,matnull,ierr); CHKERRQ(ierr)
   call MatSetNearNullSpace(Jac,matnull,ierr); CHKERRQ(ierr)
   call MatNullSpaceDestroy(matnull,ierr); CHKERRQ(ierr)

src/grid/grid_mech_spectral_basic.f90

@@ -18,7 +18,6 @@ module grid_mech_spectral_basic
   use math
   use rotations
   use spectral_utilities
-  use FEsolving
   use config
   use homogenization
   use discretization_grid
@@ -94,8 +93,6 @@ contains
 subroutine grid_mech_spectral_basic_init
 
   real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P
-  real(pReal), dimension(3,3) :: &
-    temp33_Real = 0.0_pReal
   PetscErrorCode :: ierr
   PetscScalar, pointer, dimension(:,:,:,:) :: &
     F                                                                                               ! pointer to solution data
@@ -118,20 +115,20 @@ subroutine grid_mech_spectral_basic_init
 
 !-------------------------------------------------------------------------------------------------
 ! debugging options
-  debug_grid => config_debug%get('grid', defaultVal=emptyList)
+  debug_grid => config_debug%get('grid',defaultVal=emptyList)
   debugRotation = debug_grid%contains('rotation')
 
 !-------------------------------------------------------------------------------------------------
 ! read numerical parameters and do sanity checks
   num_grid => config_numerics%get('grid',defaultVal=emptyDict)
 
-  num%update_gamma    = num_grid%get_asBool  ('update_gamma',   defaultVal=.false.)
+  num%update_gamma    = num_grid%get_asBool ('update_gamma',   defaultVal=.false.)
-  num%eps_div_atol    = num_grid%get_asFloat ('eps_div_atol',   defaultVal=1.0e-4_pReal)
+  num%eps_div_atol    = num_grid%get_asFloat('eps_div_atol',   defaultVal=1.0e-4_pReal)
-  num%eps_div_rtol    = num_grid%get_asFloat ('eps_div_rtol',   defaultVal=5.0e-4_pReal)
+  num%eps_div_rtol    = num_grid%get_asFloat('eps_div_rtol',   defaultVal=5.0e-4_pReal)
-  num%eps_stress_atol = num_grid%get_asFloat ('eps_stress_atol',defaultVal=1.0e3_pReal)
+  num%eps_stress_atol = num_grid%get_asFloat('eps_stress_atol',defaultVal=1.0e3_pReal)
-  num%eps_stress_rtol = num_grid%get_asFloat ('eps_stress_rtol',defaultVal=1.0e-3_pReal)
+  num%eps_stress_rtol = num_grid%get_asFloat('eps_stress_rtol',defaultVal=1.0e-3_pReal)
-  num%itmin           = num_grid%get_asInt   ('itmin',defaultVal=1)
+  num%itmin           = num_grid%get_asInt  ('itmin',defaultVal=1)
-  num%itmax           = num_grid%get_asInt   ('itmax',defaultVal=250)
+  num%itmax           = num_grid%get_asInt  ('itmax',defaultVal=250)
 
   if (num%eps_div_atol <= 0.0_pReal)             call IO_error(301,ext_msg='eps_div_atol')
   if (num%eps_div_rtol < 0.0_pReal)              call IO_error(301,ext_msg='eps_div_rtol')
@@ -149,14 +146,14 @@ subroutine grid_mech_spectral_basic_init
 
 !--------------------------------------------------------------------------------------------------
 ! allocate global fields
-  allocate (F_lastInc(3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
+  allocate(F_lastInc(3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
-  allocate (Fdot     (3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
+  allocate(Fdot     (3,3,grid(1),grid(2),grid3),source = 0.0_pReal)
 
 !--------------------------------------------------------------------------------------------------
 ! initialize solver specific parts of PETSc
   call SNESCreate(PETSC_COMM_WORLD,snes,ierr); CHKERRQ(ierr)
   call SNESSetOptionsPrefix(snes,'mech_',ierr);CHKERRQ(ierr)
-  localK              = 0
+  localK            = 0
   localK(worldrank) = grid3
   call MPI_Allreduce(MPI_IN_PLACE,localK,worldsize,MPI_INTEGER,MPI_SUM,PETSC_COMM_WORLD,ierr)
   call DMDACreate3d(PETSC_COMM_WORLD, &
@@ -189,6 +186,7 @@ subroutine grid_mech_spectral_basic_init
     fileHandle  = HDF5_openFile(fileName)
     groupHandle = HDF5_openGroup(fileHandle,'solver')
 
+    call HDF5_read(groupHandle,P_aim,        'P_aim')
     call HDF5_read(groupHandle,F_aim,        'F_aim')
     call HDF5_read(groupHandle,F_aim_lastInc,'F_aim_lastInc')
     call HDF5_read(groupHandle,F_aimDot,     'F_aimDot')
@@ -200,9 +198,9 @@ subroutine grid_mech_spectral_basic_init
     F = reshape(F_lastInc,[9,grid(1),grid(2),grid3])
   endif restartRead
 
-  homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3])                           ! set starting condition for materialpoint_stressAndItsTangent
+  homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3])                            ! set starting condition for materialpoint_stressAndItsTangent
   call utilities_updateCoords(reshape(F,shape(F_lastInc)))
-  call utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, &                         ! stress field, stress avg, global average of stiffness and (min+max)/2
+  call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, &                                ! stress field, stress avg, global average of stiffness and (min+max)/2
                                       reshape(F,shape(F_lastInc)), &                                ! target F
                                       0.0_pReal)                                                    ! time increment
   call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)                                ! deassociate pointer
@@ -262,6 +260,7 @@ function grid_mech_spectral_basic_solution(incInfoIn) result(solution)
   solution%iterationsNeeded = totalIter
   solution%termIll = terminallyIll
   terminallyIll = .false.
+  P_aim = merge(P_aim,P_av,params%stress_mask)
 
 end function grid_mech_spectral_basic_solution
 
@@ -269,32 +268,25 @@ end function grid_mech_spectral_basic_solution
 !--------------------------------------------------------------------------------------------------
 !> @brief forwarding routine
 !> @details find new boundary conditions and best F estimate for end of current timestep
-!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
 !--------------------------------------------------------------------------------------------------
-subroutine grid_mech_spectral_basic_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,&
+subroutine grid_mech_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,&
                                             deformation_BC,stress_BC,rotation_BC)
 
-  logical,                     intent(in) :: &
+  logical,                  intent(in) :: &
     cutBack, &
     guess
-  real(pReal),                 intent(in) :: &
+  real(pReal),              intent(in) :: &
-    timeinc_old, &
+    Delta_t_old, &
-    timeinc, &
+    Delta_t, &
-    loadCaseTime                                                                                     !< remaining time of current load case
+    t_remaining                                                                                     !< remaining time of current load case
-  type(tBoundaryCondition),    intent(in) :: &
+  type(tBoundaryCondition), intent(in) :: &
     stress_BC, &
     deformation_BC
-  type(rotation),              intent(in) :: &
+  type(rotation),           intent(in) :: &
     rotation_BC
   PetscErrorCode :: ierr
   PetscScalar, pointer, dimension(:,:,:,:) :: F
 
-!--------------------------------------------------------------------------------------------------
-! set module wide available data
-  params%stress_mask = stress_BC%mask
-  params%rotation_BC = rotation_BC
-  params%timeinc     = timeinc
-  params%timeincOld  = timeinc_old
 
   call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
 
@@ -305,7 +297,7 @@ subroutine grid_mech_spectral_basic_forward(cutBack,guess,timeinc,timeinc_old,lo
     C_volAvgLastInc    = C_volAvg
     C_minMaxAvgLastInc = C_minMaxAvg
 
-    F_aimDot = merge(merge((F_aim-F_aim_lastInc)/timeinc_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess)
+    F_aimDot = merge(merge((F_aim-F_aim_lastInc)/Delta_t_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess)  ! estimate deformation rate for prescribed stress components
     F_aim_lastInc = F_aim
 
     !-----------------------------------------------------------------------------------------------
@@ -313,40 +305,45 @@ subroutine grid_mech_spectral_basic_forward(cutBack,guess,timeinc,timeinc_old,lo
     if     (deformation_BC%myType=='L') then                                                        ! calculate F_aimDot from given L and current F
       F_aimDot = F_aimDot &
                + merge(matmul(deformation_BC%values, F_aim_lastInc),.0_pReal,deformation_BC%mask)
-    elseif(deformation_BC%myType=='dot_F') then                                                     ! F_aimDot is prescribed
+    elseif (deformation_BC%myType=='dot_F') then                                                    ! F_aimDot is prescribed
       F_aimDot = F_aimDot &
                + merge(deformation_BC%values,.0_pReal,deformation_BC%mask)
     elseif (deformation_BC%myType=='F') then                                                        ! aim at end of load case is prescribed
       F_aimDot = F_aimDot &
-               + merge((deformation_BC%values - F_aim_lastInc)/loadCaseTime,.0_pReal,deformation_BC%mask)
+               + merge((deformation_BC%values - F_aim_lastInc)/t_remaining,.0_pReal,deformation_BC%mask)
     endif
 
     Fdot = utilities_calculateRate(guess, &
-                                   F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, &
+                                   F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),Delta_t_old, &
                                    rotation_BC%rotate(F_aimDot,active=.true.))
     F_lastInc = reshape(F,[3,3,grid(1),grid(2),grid3])
 
-    homogenization_F0 = reshape(F, [3,3,1,product(grid(1:2))*grid3])
+    homogenization_F0 = reshape(F,[3,3,product(grid(1:2))*grid3])
   endif
 
 !--------------------------------------------------------------------------------------------------
 ! update average and local deformation gradients
-  F_aim = F_aim_lastInc + F_aimDot * timeinc
+  F_aim = F_aim_lastInc + F_aimDot * Delta_t
-  if     (stress_BC%myType=='P') then
+  if (stress_BC%myType=='P')     P_aim = P_aim &
-    P_aim = P_aim + merge((stress_BC%values - P_aim)/loadCaseTime*timeinc,.0_pReal,stress_BC%mask)
+                                       + merge((stress_BC%values - P_aim)/t_remaining,0.0_pReal,stress_BC%mask)*Delta_t
-  elseif (stress_BC%myType=='dot_P') then !UNTESTED
+  if (stress_BC%myType=='dot_P') P_aim = P_aim &
-    P_aim = P_aim + merge(stress_BC%values*timeinc,.0_pReal,stress_BC%mask)
+                                       + merge(stress_BC%values,0.0_pReal,stress_BC%mask)*Delta_t
-  endif
 
-  F = reshape(utilities_forwardField(timeinc,F_lastInc,Fdot, &                                      ! estimate of F at end of time+timeinc that matches rotated F_aim on average
+  F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, &                                      ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
               rotation_BC%rotate(F_aim,active=.true.)),[9,grid(1),grid(2),grid3])
   call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
 
+!--------------------------------------------------------------------------------------------------
+! set module wide available data
+  params%stress_mask = stress_BC%mask
+  params%rotation_BC = rotation_BC
+  params%timeinc     = Delta_t
+
 end subroutine grid_mech_spectral_basic_forward
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Age
+!> @brief Update coordinates
 !--------------------------------------------------------------------------------------------------
 subroutine grid_mech_spectral_basic_updateCoords
 
@@ -378,6 +375,7 @@ subroutine grid_mech_spectral_basic_restartWrite
   fileHandle  = HDF5_openFile(fileName,'w')
   groupHandle = HDF5_addGroup(fileHandle,'solver')
 
+  call HDF5_write(groupHandle,P_aim,        'P_aim')
   call HDF5_write(groupHandle,F_aim,        'F_aim')
   call HDF5_write(groupHandle,F_aim_lastInc,'F_aim_lastInc')
   call HDF5_write(groupHandle,F_aimDot,     'F_aimDot')
@@ -463,7 +461,7 @@ subroutine formResidual(in, F, &
   PetscErrorCode :: ierr
 
   call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr)
-  call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr)
+  call SNESGetIterationNumber(snes,PETScIter,ierr);  CHKERRQ(ierr)
 
   if (nfuncs == 0 .and. PETScIter == 0) totalIter = -1                                              ! new increment
 
@@ -472,11 +470,10 @@ subroutine formResidual(in, F, &
   newIteration: if (totalIter <= PETScIter) then
     totalIter = totalIter + 1
     print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
-    if (debugRotation) &
+    if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-      write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
+      ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
-              ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
+    print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-    write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
+      ' deformation gradient aim       =', transpose(F_aim)
-              ' deformation gradient aim       =', transpose(F_aim)
     flush(IO_STDOUT)
   endif newIteration
 

src/grid/grid_mech_spectral_polarisation.f90

@@ -18,7 +18,6 @@ module grid_mech_spectral_polarisation
   use math
   use rotations
   use spectral_utilities
-  use FEsolving
   use config
   use homogenization
   use discretization_grid
@@ -105,8 +104,6 @@ contains
 subroutine grid_mech_spectral_polarisation_init
 
   real(pReal), dimension(3,3,grid(1),grid(2),grid3) :: P
-  real(pReal), dimension(3,3) :: &
-    temp33_Real = 0.0_pReal
   PetscErrorCode :: ierr
   PetscScalar, pointer, dimension(:,:,:,:) :: &
     FandF_tau, &                                                                                    ! overall pointer to solution data
@@ -147,16 +144,16 @@ subroutine grid_mech_spectral_polarisation_init
   num%alpha           = num_grid%get_asFloat('alpha',          defaultVal=1.0_pReal)
   num%beta            = num_grid%get_asFloat('beta',           defaultVal=1.0_pReal)
 
-  if (num%eps_div_atol <= 0.0_pReal)                                call IO_error(301,ext_msg='eps_div_atol')
+  if (num%eps_div_atol <= 0.0_pReal)                      call IO_error(301,ext_msg='eps_div_atol')
-  if (num%eps_div_rtol < 0.0_pReal)                                 call IO_error(301,ext_msg='eps_div_rtol')
+  if (num%eps_div_rtol < 0.0_pReal)                       call IO_error(301,ext_msg='eps_div_rtol')
-  if (num%eps_curl_atol <= 0.0_pReal)                               call IO_error(301,ext_msg='eps_curl_atol')
+  if (num%eps_curl_atol <= 0.0_pReal)                     call IO_error(301,ext_msg='eps_curl_atol')
-  if (num%eps_curl_rtol < 0.0_pReal)                                call IO_error(301,ext_msg='eps_curl_rtol')
+  if (num%eps_curl_rtol < 0.0_pReal)                      call IO_error(301,ext_msg='eps_curl_rtol')
-  if (num%eps_stress_atol <= 0.0_pReal)                             call IO_error(301,ext_msg='eps_stress_atol')
+  if (num%eps_stress_atol <= 0.0_pReal)                   call IO_error(301,ext_msg='eps_stress_atol')
-  if (num%eps_stress_rtol < 0.0_pReal)                              call IO_error(301,ext_msg='eps_stress_rtol')
+  if (num%eps_stress_rtol < 0.0_pReal)                    call IO_error(301,ext_msg='eps_stress_rtol')
-  if (num%itmax <= 1)                                               call IO_error(301,ext_msg='itmax')
+  if (num%itmax <= 1)                                     call IO_error(301,ext_msg='itmax')
-  if (num%itmin > num%itmax .or. num%itmin < 1)                     call IO_error(301,ext_msg='itmin')
+  if (num%itmin > num%itmax .or. num%itmin < 1)           call IO_error(301,ext_msg='itmin')
-  if (num%alpha <= 0.0_pReal .or. num%alpha >  2.0_pReal)           call IO_error(301,ext_msg='alpha')
+  if (num%alpha <= 0.0_pReal .or. num%alpha >  2.0_pReal) call IO_error(301,ext_msg='alpha')
-  if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal)               call IO_error(301,ext_msg='beta')
+  if (num%beta < 0.0_pReal .or. num%beta > 2.0_pReal)     call IO_error(301,ext_msg='beta')
 
 !--------------------------------------------------------------------------------------------------
 ! set default and user defined options for PETSc
@@ -211,6 +208,7 @@ subroutine grid_mech_spectral_polarisation_init
     fileHandle  = HDF5_openFile(fileName)
     groupHandle = HDF5_openGroup(fileHandle,'solver')
 
+    call HDF5_read(groupHandle,P_aim,        'P_aim')
     call HDF5_read(groupHandle,F_aim,        'F_aim')
     call HDF5_read(groupHandle,F_aim_lastInc,'F_aim_lastInc')
     call HDF5_read(groupHandle,F_aimDot,     'F_aimDot')
@@ -226,9 +224,9 @@ subroutine grid_mech_spectral_polarisation_init
     F_tau_lastInc = 2.0_pReal*F_lastInc
   endif restartRead
 
-  homogenization_F0 = reshape(F_lastInc, [3,3,1,product(grid(1:2))*grid3])                           ! set starting condition for materialpoint_stressAndItsTangent
+  homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3])                            ! set starting condition for materialpoint_stressAndItsTangent
   call utilities_updateCoords(reshape(F,shape(F_lastInc)))
-  call utilities_constitutiveResponse(P,temp33_Real,C_volAvg,C_minMaxAvg, &                         ! stress field, stress avg, global average of stiffness and (min+max)/2
+  call utilities_constitutiveResponse(P,P_av,C_volAvg,C_minMaxAvg, &                                ! stress field, stress avg, global average of stiffness and (min+max)/2
                                       reshape(F,shape(F_lastInc)), &                                ! target F
                                       0.0_pReal)                                                    ! time increment
   call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr)                        ! deassociate pointer
@@ -294,6 +292,7 @@ function grid_mech_spectral_polarisation_solution(incInfoIn) result(solution)
   solution%iterationsNeeded = totalIter
   solution%termIll = terminallyIll
   terminallyIll = .false.
+  P_aim = merge(P_aim,P_av,params%stress_mask)
 
 end function grid_mech_spectral_polarisation_solution
 
@@ -301,34 +300,27 @@ end function grid_mech_spectral_polarisation_solution
 !--------------------------------------------------------------------------------------------------
 !> @brief forwarding routine
 !> @details find new boundary conditions and best F estimate for end of current timestep
-!> possibly writing restart information, triggering of state increment in DAMASK, and updating of IPcoordinates
 !--------------------------------------------------------------------------------------------------
-subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc_old,loadCaseTime,&
+subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,Delta_t,Delta_t_old,t_remaining,&
                                                    deformation_BC,stress_BC,rotation_BC)
 
-  logical,                     intent(in) :: &
+  logical,                  intent(in) :: &
     cutBack, &
     guess
-  real(pReal), intent(in) :: &
+  real(pReal),              intent(in) :: &
-    timeinc_old, &
+    Delta_t_old, &
-    timeinc, &
+    Delta_t, &
-    loadCaseTime                                                                                    !< remaining time of current load case
+    t_remaining                                                                                     !< remaining time of current load case
-  type(tBoundaryCondition),      intent(in) :: &
+  type(tBoundaryCondition), intent(in) :: &
     stress_BC, &
     deformation_BC
-  type(rotation), intent(in) :: &
+  type(rotation),           intent(in) :: &
     rotation_BC
   PetscErrorCode :: ierr
   PetscScalar, pointer, dimension(:,:,:,:) :: FandF_tau, F, F_tau
   integer :: i, j, k
   real(pReal), dimension(3,3) :: F_lambda33
 
-!--------------------------------------------------------------------------------------------------
-! set module wide available data
-  params%stress_mask = stress_BC%mask
-  params%rotation_BC = rotation_BC
-  params%timeinc     = timeinc
-  params%timeincOld  = timeinc_old
 
   call DMDAVecGetArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr)
   F     => FandF_tau(0: 8,:,:,:)
@@ -341,7 +333,7 @@ subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc
     C_volAvgLastInc    = C_volAvg
     C_minMaxAvgLastInc = C_minMaxAvg
 
-    F_aimDot = merge(merge((F_aim-F_aim_lastInc)/timeinc_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess)
+    F_aimDot = merge(merge((F_aim-F_aim_lastInc)/Delta_t_old,0.0_pReal,stress_BC%mask), 0.0_pReal, guess)  ! estimate deformation rate for prescribed stress components
     F_aim_lastInc = F_aim
 
     !-----------------------------------------------------------------------------------------------
@@ -349,60 +341,63 @@ subroutine grid_mech_spectral_polarisation_forward(cutBack,guess,timeinc,timeinc
     if     (deformation_BC%myType=='L') then                                                        ! calculate F_aimDot from given L and current F
       F_aimDot = F_aimDot &
                + merge(matmul(deformation_BC%values, F_aim_lastInc),.0_pReal,deformation_BC%mask)
-    elseif(deformation_BC%myType=='dot_F') then                                                     ! F_aimDot is prescribed
+    elseif (deformation_BC%myType=='dot_F') then                                                    ! F_aimDot is prescribed
       F_aimDot = F_aimDot &
                + merge(deformation_BC%values,.0_pReal,deformation_BC%mask)
     elseif (deformation_BC%myType=='F') then                                                        ! aim at end of load case is prescribed
       F_aimDot = F_aimDot &
-               + merge((deformation_BC%values - F_aim_lastInc)/loadCaseTime,.0_pReal,deformation_BC%mask)
+               + merge((deformation_BC%values - F_aim_lastInc)/t_remaining,.0_pReal,deformation_BC%mask)
     endif
 
     Fdot     = utilities_calculateRate(guess, &
-                                       F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),timeinc_old, &
+                                       F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),Delta_t_old, &
                                        rotation_BC%rotate(F_aimDot,active=.true.))
     F_tauDot = utilities_calculateRate(guess, &
-                                       F_tau_lastInc,reshape(F_tau,[3,3,grid(1),grid(2),grid3]), timeinc_old, &
+                                       F_tau_lastInc,reshape(F_tau,[3,3,grid(1),grid(2),grid3]), Delta_t_old, &
                                        rotation_BC%rotate(F_aimDot,active=.true.))
     F_lastInc     = reshape(F,    [3,3,grid(1),grid(2),grid3])
     F_tau_lastInc = reshape(F_tau,[3,3,grid(1),grid(2),grid3])
 
-    homogenization_F0 = reshape(F,[3,3,1,product(grid(1:2))*grid3])
+    homogenization_F0 = reshape(F,[3,3,product(grid(1:2))*grid3])
   endif
 
 !--------------------------------------------------------------------------------------------------
 ! update average and local deformation gradients
-  F_aim = F_aim_lastInc + F_aimDot * timeinc
+  F_aim = F_aim_lastInc + F_aimDot * Delta_t
-  if     (stress_BC%myType=='P') then
+  if(stress_BC%myType=='P')     P_aim = P_aim &
-    P_aim = P_aim + merge((stress_BC%values - P_aim)/loadCaseTime*timeinc,.0_pReal,stress_BC%mask)
+                                      + merge((stress_BC%values - P_aim)/t_remaining,0.0_pReal,stress_BC%mask)*Delta_t
-  elseif (stress_BC%myType=='dot_P') then !UNTESTED
+  if(stress_BC%myType=='dot_P') P_aim = P_aim &
-    P_aim = P_aim + merge(stress_BC%values*timeinc,.0_pReal,stress_BC%mask)
+                                      + merge(stress_BC%values,0.0_pReal,stress_BC%mask)*Delta_t
-  endif
 
-  F = reshape(utilities_forwardField(timeinc,F_lastInc,Fdot, &                                      ! estimate of F at end of time+timeinc that matches rotated F_aim on average
+  F = reshape(utilities_forwardField(Delta_t,F_lastInc,Fdot, &                                      ! estimate of F at end of time+Delta_t that matches rotated F_aim on average
                                      rotation_BC%rotate(F_aim,active=.true.)),&
               [9,grid(1),grid(2),grid3])
   if (guess) then
-     F_tau = reshape(Utilities_forwardField(timeinc,F_tau_lastInc,F_taudot), &
+     F_tau = reshape(Utilities_forwardField(Delta_t,F_tau_lastInc,F_taudot), &
                      [9,grid(1),grid(2),grid3])                                                     ! does not have any average value as boundary condition
    else
     do k = 1, grid3; do j = 1, grid(2); do i = 1, grid(1)
        F_lambda33 = reshape(F_tau(1:9,i,j,k)-F(1:9,i,j,k),[3,3])
-       F_lambda33 = math_mul3333xx33(S_scale,matmul(F_lambda33, &
+       F_lambda33 = math_I3 &
-                                   math_mul3333xx33(C_scale,&
+                  + math_mul3333xx33(S_scale,0.5_pReal*matmul(F_lambda33, &
-                                                    matmul(transpose(F_lambda33),&
+                    math_mul3333xx33(C_scale,matmul(transpose(F_lambda33),F_lambda33)-math_I3)))
-                                                           F_lambda33)-math_I3))*0.5_pReal) &
-                  + math_I3
        F_tau(1:9,i,j,k) = reshape(F_lambda33,[9])+F(1:9,i,j,k)
     enddo; enddo; enddo
   endif
 
   call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr)
 
+!--------------------------------------------------------------------------------------------------
+! set module wide available data
+  params%stress_mask = stress_BC%mask
+  params%rotation_BC = rotation_BC
+  params%timeinc     = Delta_t
+
 end subroutine grid_mech_spectral_polarisation_forward
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Age
+!> @brief Update coordinates
 !--------------------------------------------------------------------------------------------------
 subroutine grid_mech_spectral_polarisation_updateCoords
 
@@ -436,6 +431,7 @@ subroutine grid_mech_spectral_polarisation_restartWrite
   fileHandle  = HDF5_openFile(fileName,'w')
   groupHandle = HDF5_addGroup(fileHandle,'solver')
 
+  call HDF5_write(groupHandle,F_aim,        'P_aim')
   call HDF5_write(groupHandle,F_aim,        'F_aim')
   call HDF5_write(groupHandle,F_aim_lastInc,'F_aim_lastInc')
   call HDF5_write(groupHandle,F_aimDot,     'F_aimDot')
@@ -480,11 +476,11 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
   divTol     = max(maxval(abs(P_av))         *num%eps_div_rtol   ,num%eps_div_atol)
   BCTol      = max(maxval(abs(P_av))         *num%eps_stress_rtol,num%eps_stress_atol)
 
-  if ((totalIter >= num%itmin .and. &
+  if (terminallyIll .or. &
-                            all([ err_div /divTol, &
+      (totalIter >= num%itmin .and. &
-                                  err_curl/curlTol, &
+       all([ err_div /divTol, &
-                                  err_BC  /BCTol       ] < 1.0_pReal)) &
+             err_curl/curlTol, &
-              .or.    terminallyIll) then
+             err_BC  /BCTol   ] < 1.0_pReal))) then
     reason = 1
   elseif (totalIter >= num%itmax) then
     reason = -1
@@ -555,11 +551,10 @@ subroutine formResidual(in, FandF_tau, &
   newIteration: if (totalIter <= PETScIter) then
     totalIter = totalIter + 1
     print'(1x,a,3(a,i0))', trim(incInfo), ' @ Iteration ', num%itmin, '≤',totalIter, '≤', num%itmax
-    if(debugRotation) &
+    if (debugRotation) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-      write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
+      ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
-              ' deformation gradient aim (lab) =', transpose(params%rotation_BC%rotate(F_aim,active=.true.))
+    print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-    write(IO_STDOUT,'(/,a,/,3(3(f12.7,1x)/))',advance='no') &
+      ' deformation gradient aim       =', transpose(F_aim)
-              ' deformation gradient aim       =', transpose(F_aim)
     flush(IO_STDOUT)
   endif newIteration
 
@@ -608,7 +603,7 @@ subroutine formResidual(in, FandF_tau, &
   do k = 1, grid3; do j = 1, grid(2); do i = 1, grid(1)
     e = e + 1
     residual_F(1:3,1:3,i,j,k) = &
-      math_mul3333xx33(math_invSym3333(homogenization_dPdF(1:3,1:3,1:3,1:3,1,e) + C_scale), &
+      math_mul3333xx33(math_invSym3333(homogenization_dPdF(1:3,1:3,1:3,1:3,e) + C_scale), &
                        residual_F(1:3,1:3,i,j,k) - matmul(F(1:3,1:3,i,j,k), &
                        math_mul3333xx33(C_scale,F_tau(1:3,1:3,i,j,k) - F(1:3,1:3,i,j,k) - math_I3))) &
                        + residual_F_tau(1:3,1:3,i,j,k)

src/grid/grid_thermal_spectral.f90

@@ -131,8 +131,7 @@ subroutine grid_thermal_spectral_init
   cell = 0
   do k = 1, grid3; do j = 1, grid(2); do i = 1,grid(1)
     cell = cell + 1
-    T_current(i,j,k) = temperature(material_homogenizationAt(cell))% &
+    T_current(i,j,k) = temperature(material_homogenizationAt(cell))%p(material_homogenizationMemberAt(1,cell))
-                                   p(thermalMapping(material_homogenizationAt(cell))%p(1,cell))
     T_lastInc(i,j,k) = T_current(i,j,k)
     T_stagInc(i,j,k) = T_current(i,j,k)
   enddo; enddo; enddo
@@ -197,8 +196,7 @@ function grid_thermal_spectral_solution(timeinc) result(solution)
   call VecMax(solution_vec,devNull,T_max,ierr); CHKERRQ(ierr)
   if (solution%converged) &
     print'(/,a)', ' ... thermal conduction converged ..................................'
-  write(IO_STDOUT,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',&
+  print'(/,a,f8.4,2x,f8.4,2x,f8.4)', ' Minimum|Maximum|Delta Temperature / K = ', T_min, T_max, stagNorm
-                                                        T_min, T_max, stagNorm
   print'(/,a)', ' ==========================================================================='
   flush(IO_STDOUT) 
 
@@ -258,7 +256,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
   PetscObject :: dummy
   PetscErrorCode :: ierr
   integer :: i, j, k, cell
-  real(pReal)   :: Tdot, dTdot_dT
+  real(pReal)   :: Tdot
 
   T_current = x_scal 
 !--------------------------------------------------------------------------------------------------
@@ -280,7 +278,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
   cell = 0
   do k = 1, grid3;  do j = 1, grid(2);  do i = 1,grid(1)
     cell = cell + 1
-    call thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T_current(i,j,k), 1, cell)
+    call thermal_conduction_getSource(Tdot, T_current(i,j,k), 1, cell)
     scalarField_real(i,j,k) = params%timeinc*(scalarField_real(i,j,k) + Tdot) &
                             + thermal_conduction_getMassDensity (1,cell)* &
                               thermal_conduction_getSpecificHeat(1,cell)*(T_lastInc(i,j,k)  - &

src/grid/spectral_utilities.f90

@@ -93,7 +93,7 @@ module spectral_utilities
     real(pReal), dimension(3,3) :: stress_BC
     logical, dimension(3,3)     :: stress_mask
     type(rotation)              :: rotation_BC
-    real(pReal) :: timeinc, timeincOld
+    real(pReal) :: timeinc
   end type tSolutionParams
 
   type :: tNumerics
@@ -688,8 +688,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
 
     if(debugGeneral) then
       print'(/,a)', ' ... updating masked compliance ............................................'
-      write(IO_STDOUT,'(/,a,/,9(9(2x,f12.7,1x)/))',advance='no') ' Stiffness C (load) / GPa =',&
+      print'(/,a,/,8(9(2x,f12.7,1x)/),9(2x,f12.7,1x))', &
-                                                   transpose(temp99_Real)*1.0e-9_pReal
+        ' Stiffness C (load) / GPa =', transpose(temp99_Real)*1.0e-9_pReal
       flush(IO_STDOUT)
     endif
 
@@ -709,9 +709,8 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
     if (debugGeneral .or. errmatinv) then
       write(formatString, '(i2)') size_reduced
       formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))'
-      write(IO_STDOUT,trim(formatString),advance='no') ' C * S (load) ', &
+      print trim(formatString), ' C * S (load) ', transpose(matmul(c_reduced,s_reduced))
-                                                             transpose(matmul(c_reduced,s_reduced))
+      print trim(formatString), ' S (load) ', transpose(s_reduced)
-      write(IO_STDOUT,trim(formatString),advance='no') ' S (load) ', transpose(s_reduced)
       if(errmatinv) error stop 'matrix inversion error'
     endif
     temp99_real = reshape(unpack(reshape(s_reduced,[size_reduced**2]),reshape(mask,[81]),0.0_pReal),[9,9])
@@ -722,7 +721,7 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
   utilities_maskedCompliance = math_99to3333(temp99_Real)
 
   if(debugGeneral) then
-    write(IO_STDOUT,'(/,a,/,9(9(2x,f10.5,1x)/),/)',advance='no') &
+    print'(/,a,/,9(9(2x,f10.5,1x)/),9(2x,f10.5,1x))', &
       ' Masked Compliance (load) * GPa =', transpose(temp99_Real)*1.0e9_pReal
     flush(IO_STDOUT)
   endif
@@ -811,20 +810,18 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
   print'(/,a)', ' ... evaluating constitutive response ......................................'
   flush(IO_STDOUT)
 
-  homogenization_F  = reshape(F,[3,3,1,product(grid(1:2))*grid3])                                    ! set materialpoint target F to estimated field
+  homogenization_F  = reshape(F,[3,3,product(grid(1:2))*grid3])                                     ! set materialpoint target F to estimated field
 
-  call materialpoint_stressAndItsTangent(timeinc)                                                   ! calculate P field
+  call materialpoint_stressAndItsTangent(timeinc,[1,1],[1,product(grid(1:2))*grid3])                ! calculate P field
 
   P = reshape(homogenization_P, [3,3,grid(1),grid(2),grid3])
   P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt                                                   ! average of P
   call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
-  if (debugRotation) &
+  if (debugRotation) print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
-  write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress (lab) / MPa =',&
+    ' Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pReal
-                                                      transpose(P_av)*1.e-6_pReal
+  if(present(rotation_BC)) P_av = rotation_BC%rotate(P_av)
-  if(present(rotation_BC)) &
+  print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
-    P_av = rotation_BC%rotate(P_av)
+    ' Piola--Kirchhoff stress       / MPa =', transpose(P_av)*1.e-6_pReal
-  write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress       / MPa =',&
-                                                      transpose(P_av)*1.e-6_pReal
   flush(IO_STDOUT)
 
   dPdF_max = 0.0_pReal
@@ -832,13 +829,13 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
   dPdF_min = huge(1.0_pReal)
   dPdF_norm_min = huge(1.0_pReal)
   do i = 1, product(grid(1:2))*grid3
-    if (dPdF_norm_max < sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)) then
+    if (dPdF_norm_max < sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)) then
-      dPdF_max = homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)
+      dPdF_max = homogenization_dPdF(1:3,1:3,1:3,1:3,i)
-      dPdF_norm_max = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)
+      dPdF_norm_max = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)
     endif
-    if (dPdF_norm_min > sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)) then
+    if (dPdF_norm_min > sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)) then
-      dPdF_min = homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)
+      dPdF_min = homogenization_dPdF(1:3,1:3,1:3,1:3,i)
-      dPdF_norm_min = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,1,i)**2.0_pReal)
+      dPdF_norm_min = sum(homogenization_dPdF(1:3,1:3,1:3,1:3,i)**2.0_pReal)
     endif
   end do
 
@@ -856,7 +853,7 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
 
   C_minmaxAvg = 0.5_pReal*(dPdF_max + dPdF_min)
 
-  C_volAvg = sum(sum(homogenization_dPdF,dim=6),dim=5)
+  C_volAvg = sum(homogenization_dPdF,dim=5)
   call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
   if (ierr /= 0) error stop 'MPI error'
   C_volAvg = C_volAvg * wgt

src/homogenization.f90

@@ -11,15 +11,12 @@ module homogenization
   use math
   use material
   use constitutive
-  use crystallite
-  use FEsolving
   use discretization
   use thermal_isothermal
-  use thermal_adiabatic
   use thermal_conduction
   use damage_none
-  use damage_local
   use damage_nonlocal
+  use HDF5_utilities
   use results
 
   implicit none
@@ -30,14 +27,18 @@ module homogenization
 
 !--------------------------------------------------------------------------------------------------
 ! General variables for the homogenization at a  material point
-  real(pReal),   dimension(:,:,:,:),     allocatable, public :: &
+  real(pReal),   dimension(:),         allocatable, public :: &
-    homogenization_F0, &                                                                             !< def grad of IP at start of FE increment
+    homogenization_T
-    homogenization_F                                                                                 !< def grad of IP to be reached at end of FE increment
+  real(pReal),   dimension(:,:,:),     allocatable, public :: &
-  real(pReal),   dimension(:,:,:,:),     allocatable, public, protected :: &
+    homogenization_F0, &                                                                            !< def grad of IP at start of FE increment
-    homogenization_P                                                                                 !< first P--K stress of IP
+    homogenization_F                                                                                !< def grad of IP to be reached at end of FE increment
-  real(pReal),   dimension(:,:,:,:,:,:), allocatable, public, protected ::  &
+  real(pReal),   dimension(:,:,:),     allocatable, public :: & !, protected :: &                   Issue with ifort
-    homogenization_dPdF                                                                              !< tangent of first P--K stress at IP
+    homogenization_P                                                                                !< first P--K stress of IP
+  real(pReal),   dimension(:,:,:,:,:), allocatable, public :: & !, protected ::  &
+    homogenization_dPdF                                                                             !< tangent of first P--K stress at IP
 
+
+!--------------------------------------------------------------------------------------------------
   type :: tNumerics
     integer :: &
       nMPstate                                                                                      !< materialpoint state loop limit
@@ -49,91 +50,64 @@ module homogenization
 
   type(tNumerics) :: num
 
-  type :: tDebugOptions
+!--------------------------------------------------------------------------------------------------
-    logical :: &
-      basic, &
-      extensive, &
-      selective
-    integer :: &
-      element, &
-      ip, &
-      grain
-  end type tDebugOptions
-
-  type(tDebugOptions) :: debugHomog
-
   interface
 
-    module subroutine mech_none_init
+    module subroutine mech_init(num_homog)
-    end subroutine mech_none_init
-
-    module subroutine mech_isostrain_init
-    end subroutine mech_isostrain_init
-
-    module subroutine mech_RGC_init(num_homogMech)
       class(tNode), pointer, intent(in) :: &
-        num_homogMech                                                                               !< pointer to mechanical homogenization numerics data
+        num_homog                                                                                   !< pointer to mechanical homogenization numerics data
-    end subroutine mech_RGC_init
+    end subroutine mech_init
 
+    module subroutine thermal_init
+    end subroutine thermal_init
 
-    module subroutine mech_isostrain_partitionDeformation(F,avgF)
+    module subroutine mech_partition(subF,ip,el)
-      real(pReal),   dimension (:,:,:), intent(out) :: F                                            !< partitioned deformation gradient
+      real(pReal), intent(in), dimension(3,3) :: &
-      real(pReal),   dimension (3,3),   intent(in)  :: avgF                                         !< average deformation gradient at material point
+        subF
-    end subroutine mech_isostrain_partitionDeformation
+      integer,     intent(in) :: &
-
+        ip, &                                                                                       !< integration point
-    module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
-      real(pReal),   dimension (:,:,:), intent(out) :: F                                            !< partitioned deformation gradient
-      real(pReal),   dimension (3,3),   intent(in)  :: avgF                                         !< average deformation gradient at material point
-      integer,                          intent(in)  :: &
-        instance, &
-        of
-    end subroutine mech_RGC_partitionDeformation
-
-
-    module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
-      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 (:,:,:),     intent(in)  :: P                                        !< partitioned stresses
-      real(pReal),   dimension (:,:,:,:,:), intent(in)  :: dPdF                                     !< partitioned stiffnesses
-      integer,                              intent(in)  :: instance
-    end subroutine mech_isostrain_averageStressAndItsTangent
-
-    module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
-      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 (:,:,:),     intent(in)  :: P                                        !< partitioned stresses
-      real(pReal),   dimension (:,:,:,:,:), intent(in)  :: dPdF                                     !< partitioned stiffnesses
-      integer,                              intent(in)  :: instance
-    end subroutine mech_RGC_averageStressAndItsTangent
-
-    module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
-      logical, dimension(2) :: mech_RGC_updateState
-      real(pReal), dimension(:,:,:),     intent(in)    :: &
-        P,&                                                                                         !< partitioned stresses
-        F,&                                                                                         !< partitioned deformation gradients
-        F0                                                                                          !< partitioned initial deformation gradients
-      real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF                                         !< partitioned stiffnesses
-      real(pReal), dimension(3,3),       intent(in) :: avgF                                         !< average F
-      real(pReal),                       intent(in) :: dt                                           !< time increment
-      integer,                           intent(in) :: &
-        ip, &                                                                                       !< integration point number
         el                                                                                          !< element number
-    end function mech_RGC_updateState
+    end subroutine mech_partition
 
+    module subroutine thermal_partition(T,ip,el)
+      real(pReal), intent(in) :: T
+      integer,     intent(in) :: &
+        ip, &                                                                                           !< integration point
+        el                                                                                              !< element number
+    end subroutine thermal_partition
 
-    module subroutine mech_RGC_results(instance,group)
+    module subroutine mech_homogenize(dt,ip,el)
-      integer,          intent(in) :: instance                                                      !< homogenization instance
+     real(pReal), intent(in) :: dt
-      character(len=*), intent(in) :: group                                                         !< group name in HDF5 file
+     integer, intent(in) :: &
-    end subroutine mech_RGC_results
+       ip, &                                                                                        !< integration point
+       el                                                                                           !< element number
+    end subroutine mech_homogenize
+
+    module subroutine mech_results(group_base,h)
+      character(len=*), intent(in) :: group_base
+      integer, intent(in)          :: h
+    end subroutine mech_results
+
+    module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy)
+      real(pReal), intent(in) :: &
+        subdt                                                                                           !< current time step
+      real(pReal), intent(in), dimension(3,3) :: &
+        subF
+      integer,     intent(in) :: &
+        ip, &                                                                                           !< integration point
+        el                                                                                              !< element number
+      logical, dimension(2) :: doneAndHappy
+    end function mech_updateState
 
   end interface
 
   public ::  &
     homogenization_init, &
     materialpoint_stressAndItsTangent, &
-    homogenization_results
+    homogenization_forward, &
+    homogenization_results, &
+    homogenization_restartRead, &
+    homogenization_restartWrite
 
 contains
 
@@ -145,49 +119,13 @@ subroutine homogenization_init
 
   class (tNode) , pointer :: &
     num_homog, &
-    num_homogMech, &
+    num_homogGeneric
-    num_homogGeneric, &
-    debug_homogenization
-
-  debug_homogenization => config_debug%get('homogenization', defaultVal=emptyList)
-  debugHomog%basic       =  debug_homogenization%contains('basic')
-  debugHomog%extensive   =  debug_homogenization%contains('extensive')
-  debugHomog%selective   =  debug_homogenization%contains('selective')
-  debugHomog%element     =  config_debug%get_asInt('element',defaultVal = 1)
-  debugHomog%ip          =  config_debug%get_asInt('integrationpoint',defaultVal = 1)
-  debugHomog%grain       =  config_debug%get_asInt('grain',defaultVal = 1)
-
-  if (debugHomog%grain < 1 &
-    .or. debugHomog%grain > homogenization_Nconstituents(material_homogenizationAt(debugHomog%element))) &
-    call IO_error(602,ext_msg='constituent', el=debugHomog%element, g=debugHomog%grain)
-
-
-  num_homog        => config_numerics%get('homogenization',defaultVal=emptyDict)
-  num_homogMech    => num_homog%get('mech',defaultVal=emptyDict)
-  num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict)
-
-  if (any(homogenization_type == HOMOGENIZATION_NONE_ID))      call mech_none_init
-  if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init
-  if (any(homogenization_type == HOMOGENIZATION_RGC_ID))       call mech_RGC_init(num_homogMech)
-
-  if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init
-  if (any(thermal_type == THERMAL_adiabatic_ID))  call thermal_adiabatic_init
-  if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init
-
-  if (any(damage_type == DAMAGE_none_ID))      call damage_none_init
-  if (any(damage_type == DAMAGE_local_ID))     call damage_local_init
-  if (any(damage_type == DAMAGE_nonlocal_ID))  call damage_nonlocal_init
-
-
-!--------------------------------------------------------------------------------------------------
-! allocate and initialize global variables
-  allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs,discretization_Nelems),       source=0.0_pReal)
-  homogenization_F0 = spread(spread(math_I3,3,discretization_nIPs),4,discretization_Nelems)            ! initialize to identity
-  homogenization_F = homogenization_F0                                                                ! initialize to identity
-  allocate(homogenization_P(3,3,discretization_nIPs,discretization_Nelems),              source=0.0_pReal)
 
   print'(/,a)', ' <<<+-  homogenization init  -+>>>'; flush(IO_STDOUT)
 
+  num_homog        => config_numerics%get('homogenization',defaultVal=emptyDict)
+  num_homogGeneric => num_homog%get('generic',defaultVal=emptyDict)
+
   num%nMPstate          = num_homogGeneric%get_asInt  ('nMPstate',     defaultVal=10)
   num%subStepMinHomog   = num_homogGeneric%get_asFloat('subStepMin',   defaultVal=1.0e-3_pReal)
   num%subStepSizeHomog  = num_homogGeneric%get_asFloat('subStepSize',  defaultVal=0.25_pReal)
@@ -198,190 +136,141 @@ subroutine homogenization_init
   if (num%subStepSizeHomog <= 0.0_pReal)  call IO_error(301,ext_msg='subStepSizeHomog')
   if (num%stepIncreaseHomog <= 0.0_pReal) call IO_error(301,ext_msg='stepIncreaseHomog')
 
+
+  call mech_init(num_homog)
+  call thermal_init()
+
+  if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init(homogenization_T)
+  if (any(thermal_type == THERMAL_conduction_ID)) call thermal_conduction_init(homogenization_T)
+
+  if (any(damage_type == DAMAGE_none_ID))      call damage_none_init
+  if (any(damage_type == DAMAGE_nonlocal_ID))  call damage_nonlocal_init
+
+
 end subroutine homogenization_init
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief  parallelized calculation of stress and corresponding tangent at material points
 !--------------------------------------------------------------------------------------------------
-subroutine materialpoint_stressAndItsTangent(dt)
+subroutine materialpoint_stressAndItsTangent(dt,FEsolving_execIP,FEsolving_execElem)
 
   real(pReal), intent(in) :: dt                                                                     !< time increment
+  integer, dimension(2), intent(in) :: FEsolving_execElem, FEsolving_execIP
   integer :: &
-    NiterationHomog, &
     NiterationMPstate, &
-    i, &                                                                                            !< integration point number
+    ip, &                                                                                            !< integration point number
-    e, &                                                                                            !< element number
+    el, &                                                                                            !< element number
-    myNgrains
+    myNgrains, co, ce, ho, me
-  real(pReal), dimension(discretization_nIPs,discretization_Nelems) :: &
+  real(pReal) :: &
     subFrac, &
     subStep
-  logical,     dimension(discretization_nIPs,discretization_Nelems) :: &
+  logical :: &
-    requested, &
     converged
-  logical,     dimension(2,discretization_nIPs,discretization_Nelems) :: &
+  logical, dimension(2) :: &
     doneAndHappy
 
 
+  !$OMP PARALLEL DO PRIVATE(ce,me,ho,myNgrains,NiterationMPstate,subFrac,converged,subStep,doneAndHappy)
+  do el = FEsolving_execElem(1),FEsolving_execElem(2)
+    ho = material_homogenizationAt(el)
+    myNgrains = homogenization_Nconstituents(ho)
+    do ip = FEsolving_execIP(1),FEsolving_execIP(2)
+      me = material_homogenizationMemberAt(ip,el)
 !--------------------------------------------------------------------------------------------------
 ! initialize restoration points
-  do e = FEsolving_execElem(1),FEsolving_execElem(2)
+      call constitutive_initializeRestorationPoints(ip,el)
-    do i = FEsolving_execIP(1),FEsolving_execIP(2);
 
-      call crystallite_initializeRestorationPoints(i,e)
+      subFrac = 0.0_pReal
+      converged = .false.                                                                           ! pretend failed step ...
+      subStep = 1.0_pReal/num%subStepSizeHomog                                                      ! ... larger then the requested calculation
 
-      subFrac(i,e) = 0.0_pReal
+      if (homogState(ho)%sizeState > 0)   homogState(ho)%subState0(:,me)  = homogState(ho)%State0(:,me)
-      converged(i,e) = .false.                                                                      ! pretend failed step ...
+      if (damageState_h(ho)%sizeState > 0)  damageState_h(ho)%subState0(:,me) = damageState_h(ho)%State0(:,me)
-      subStep(i,e) = 1.0_pReal/num%subStepSizeHomog                                                 ! ... larger then the requested calculation
-      requested(i,e) = .true.                                                                       ! everybody requires calculation
 
-      if (homogState(material_homogenizationAt(e))%sizeState > 0) &
+      cutBackLooping: do while (.not. terminallyIll .and. subStep  > num%subStepMinHomog)
-          homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
-          homogState(material_homogenizationAt(e))%State0(   :,material_homogenizationMemberAt(i,e))
 
-      if (thermalState(material_homogenizationAt(e))%sizeState > 0) &
+        if (converged) then
-          thermalState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
+          subFrac = subFrac + subStep
-          thermalState(material_homogenizationAt(e))%State0(   :,material_homogenizationMemberAt(i,e))
+          subStep = min(1.0_pReal-subFrac,num%stepIncreaseHomog*subStep)             ! introduce flexibility for step increase/acceleration
 
-      if (damageState(material_homogenizationAt(e))%sizeState > 0) &
+          steppingNeeded: if (subStep > num%subStepMinHomog) then
-          damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
-          damageState(material_homogenizationAt(e))%State0(   :,material_homogenizationMemberAt(i,e))
-    enddo
-  enddo
-
-  NiterationHomog = 0
-
-  cutBackLooping: do while (.not. terminallyIll .and. &
-       any(subStep(FEsolving_execIP(1):FEsolving_execIP(2),&
-                   FEsolving_execElem(1):FEsolving_execElem(2)) > num%subStepMinHomog))
-
-    !$OMP PARALLEL DO
-    elementLooping1: do e = FEsolving_execElem(1),FEsolving_execElem(2)
-      myNgrains = homogenization_Nconstituents(material_homogenizationAt(e))
-      IpLooping1: do i = FEsolving_execIP(1),FEsolving_execIP(2)
-
-        if (converged(i,e)) then
-          subFrac(i,e) = subFrac(i,e) + subStep(i,e)
-          subStep(i,e) = min(1.0_pReal-subFrac(i,e),num%stepIncreaseHomog*subStep(i,e))             ! introduce flexibility for step increase/acceleration
-
-          steppingNeeded: if (subStep(i,e) > num%subStepMinHomog) then
 
             ! wind forward grain starting point
-            call crystallite_windForward(i,e)
+            call constitutive_windForward(ip,el)
 
-            if(homogState(material_homogenizationAt(e))%sizeState > 0) &
+            if(homogState(ho)%sizeState > 0)  homogState(ho)%subState0(:,me) = homogState(ho)%State(:,me)
-                homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
+            if(damageState_h(ho)%sizeState > 0) damageState_h(ho)%subState0(:,me) = damageState_h(ho)%State(:,me)
-                homogState(material_homogenizationAt(e))%State    (:,material_homogenizationMemberAt(i,e))
-            if(thermalState(material_homogenizationAt(e))%sizeState > 0) &
-                thermalState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
-                thermalState(material_homogenizationAt(e))%State    (:,material_homogenizationMemberAt(i,e))
-            if(damageState(material_homogenizationAt(e))%sizeState > 0) &
-                damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e)) = &
-                damageState(material_homogenizationAt(e))%State    (:,material_homogenizationMemberAt(i,e))
 
           endif steppingNeeded
-
+        elseif ( (myNgrains == 1 .and. subStep <= 1.0 ) .or. &                                   ! single grain already tried internal subStepping in crystallite
-        else
+               num%subStepSizeHomog * subStep <=  num%subStepMinHomog ) then                   ! would require too small subStep
-          if ( (myNgrains == 1 .and. subStep(i,e) <= 1.0 ) .or. &                                   ! single grain already tried internal subStepping in crystallite
-               num%subStepSizeHomog * subStep(i,e) <=  num%subStepMinHomog ) then                   ! would require too small subStep
                                                                                                     ! cutback makes no sense
-            if (.not. terminallyIll) then                                                           ! so first signals terminally ill...
+          if (.not. terminallyIll) &                                                           ! so first signals terminally ill...
-              print*, ' Integration point ', i,' at element ', e, ' terminally ill'
+            print*, ' Integration point ', ip,' at element ', el, ' terminally ill'
-            endif
+          terminallyIll = .true.                                                                  ! ...and kills all others
-            terminallyIll = .true.                                                                  ! ...and kills all others
+        else                                                                                      ! cutback makes sense
-          else                                                                                      ! cutback makes sense
+          subStep = num%subStepSizeHomog * subStep                                      ! crystallite had severe trouble, so do a significant cutback
-            subStep(i,e) = num%subStepSizeHomog * subStep(i,e)                                      ! crystallite had severe trouble, so do a significant cutback
 
-            call crystallite_restore(i,e,subStep(i,e) < 1.0_pReal)
+          call constitutive_restore(ip,el,subStep < 1.0_pReal)
 
-            if(homogState(material_homogenizationAt(e))%sizeState > 0) &
+          if(homogState(ho)%sizeState > 0)  homogState(ho)%State(:,me) = homogState(ho)%subState0(:,me)
-                homogState(material_homogenizationAt(e))%State(    :,material_homogenizationMemberAt(i,e)) = &
+          if(damageState_h(ho)%sizeState > 0) damageState_h(ho)%State(:,me) = damageState_h(ho)%subState0(:,me)
-                homogState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e))
-            if(thermalState(material_homogenizationAt(e))%sizeState > 0) &
-                thermalState(material_homogenizationAt(e))%State(    :,material_homogenizationMemberAt(i,e)) = &
-                thermalState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e))
-            if(damageState(material_homogenizationAt(e))%sizeState > 0) &
-                damageState(material_homogenizationAt(e))%State(    :,material_homogenizationMemberAt(i,e)) = &
-                damageState(material_homogenizationAt(e))%subState0(:,material_homogenizationMemberAt(i,e))
-          endif
         endif
 
-        if (subStep(i,e) > num%subStepMinHomog) then
+        if (subStep > num%subStepMinHomog) doneAndHappy = [.false.,.true.]
-          requested(i,e) = .true.
-          doneAndHappy(1:2,i,e) = [.false.,.true.]
-        endif
-      enddo IpLooping1
-    enddo elementLooping1
-    !$OMP END PARALLEL DO
 
-    NiterationMPstate = 0
+        NiterationMPstate = 0
-
+        convergenceLooping: do while (.not. terminallyIll &
-    convergenceLooping: do while (.not. terminallyIll .and. &
+                       .and. .not. doneAndHappy(1) &
-              any(                 requested(:,FEsolving_execELem(1):FEsolving_execElem(2)) &
+                       .and. NiterationMPstate < num%nMPstate)
-                  .and. .not. doneAndHappy(1,:,FEsolving_execELem(1):FEsolving_execElem(2)) &
+          NiterationMPstate = NiterationMPstate + 1
-                 ) .and. &
-              NiterationMPstate < num%nMPstate)
-      NiterationMPstate = NiterationMPstate + 1
 
 !--------------------------------------------------------------------------------------------------
 ! deformation partitioning
-      !$OMP PARALLEL DO PRIVATE(myNgrains)
-      elementLooping2: do e = FEsolving_execElem(1),FEsolving_execElem(2)
-        myNgrains = homogenization_Nconstituents(material_homogenizationAt(e))
-        IpLooping2: do i = FEsolving_execIP(1),FEsolving_execIP(2)
-          if(requested(i,e) .and. .not. doneAndHappy(1,i,e)) then                                   ! requested but not yet done
-            call partitionDeformation(homogenization_F0(1:3,1:3,i,e) &
-                                      + (homogenization_F(1:3,1:3,i,e)-homogenization_F0(1:3,1:3,i,e))&
-                                         *(subStep(i,e)+subFrac(i,e)), &
-                                      i,e)
-            crystallite_dt(1:myNgrains,i,e) = dt*subStep(i,e)                                       ! propagate materialpoint dt to grains
-            crystallite_requested(1:myNgrains,i,e) = .true.                                         ! request calculation for constituents
-          else
-            crystallite_requested(1:myNgrains,i,e) = .false.                                        ! calculation for constituents not required anymore
-          endif
-        enddo IpLooping2
-      enddo elementLooping2
-      !$OMP END PARALLEL DO
 
-!--------------------------------------------------------------------------------------------------
+          if (.not. doneAndHappy(1)) then
-! crystallite integration
+            ce = (el-1)*discretization_nIPs + ip
-      converged = crystallite_stress() !ToDo: MD not sure if that is the best logic
+            call mech_partition(homogenization_F0(1:3,1:3,ce) &
+                                      + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce))&
+                                         *(subStep+subFrac), &
+                                      ip,el)
+            converged = .true.
+            do co = 1, myNgrains
+              converged = converged .and. crystallite_stress(dt*subStep,co,ip,el)
+            enddo
 
-!--------------------------------------------------------------------------------------------------
+            if (.not. converged) then
-! state update
+              doneAndHappy = [.true.,.false.]
-     !$OMP PARALLEL DO
-      elementLooping3: do e = FEsolving_execElem(1),FEsolving_execElem(2)
-        IpLooping3: do i = FEsolving_execIP(1),FEsolving_execIP(2)
-          if (requested(i,e) .and. .not. doneAndHappy(1,i,e)) then
-            if (.not. converged(i,e)) then
-              doneAndHappy(1:2,i,e) = [.true.,.false.]
             else
-              doneAndHappy(1:2,i,e) = updateState(dt*subStep(i,e), &
+              ce = (el-1)*discretization_nIPs + ip
-                                                  homogenization_F0(1:3,1:3,i,e) &
+              doneAndHappy = mech_updateState(dt*subStep, &
-                                                  + (homogenization_F(1:3,1:3,i,e)-homogenization_F0(1:3,1:3,i,e)) &
+                                              homogenization_F0(1:3,1:3,ce) &
-                                                     *(subStep(i,e)+subFrac(i,e)), &
+                                              + (homogenization_F(1:3,1:3,ce)-homogenization_F0(1:3,1:3,ce)) &
-                                                 i,e)
+                                                     *(subStep+subFrac), &
-              converged(i,e) = all(doneAndHappy(1:2,i,e))                                           ! converged if done and happy
+                                              ip,el)
+              converged = all(doneAndHappy)
             endif
           endif
-        enddo IpLooping3
-      enddo elementLooping3
-      !$OMP END PARALLEL DO
 
-    enddo convergenceLooping
+        enddo convergenceLooping
-
+      enddo cutBackLooping
-    NiterationHomog = NiterationHomog + 1
+    enddo
-
+  enddo
-  enddo cutBackLooping
+  !$OMP END PARALLEL DO
 
   if (.not. terminallyIll ) then
-    call crystallite_orientations()                                                                 ! calculate crystal orientations
+    !$OMP PARALLEL DO PRIVATE(ho,myNgrains)
-    !$OMP PARALLEL DO
+    elementLooping3: do el = FEsolving_execElem(1),FEsolving_execElem(2)
-    elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2)
+      ho = material_homogenizationAt(el)
-      IpLooping4: do i = FEsolving_execIP(1),FEsolving_execIP(2)
+      myNgrains = homogenization_Nconstituents(ho)
-        call averageStressAndItsTangent(i,e)
+      IpLooping3: do ip = FEsolving_execIP(1),FEsolving_execIP(2)
-      enddo IpLooping4
+        do co = 1, myNgrains
-    enddo elementLooping4
+          call crystallite_orientations(co,ip,el)
+        enddo
+        call mech_homogenize(dt,ip,el)
+      enddo IpLooping3
+    enddo elementLooping3
     !$OMP END PARALLEL DO
   else
     print'(/,a,/)', ' << HOMOG >> Material Point terminally ill'
@@ -390,189 +279,111 @@ subroutine materialpoint_stressAndItsTangent(dt)
 end subroutine materialpoint_stressAndItsTangent
 
 
-!--------------------------------------------------------------------------------------------------
-!> @brief  partition material point def grad onto constituents
-!--------------------------------------------------------------------------------------------------
-subroutine partitionDeformation(subF,ip,el)
-
-  real(pReal), intent(in), dimension(3,3) :: &
-    subF
-  integer,     intent(in) :: &
-    ip, &                                                                                           !< integration point
-    el                                                                                              !< element number
-
-  chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
-
-    case (HOMOGENIZATION_NONE_ID) chosenHomogenization
-      crystallite_partitionedF(1:3,1:3,1,ip,el) = subF
-
-    case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
-      call mech_isostrain_partitionDeformation(&
-                           crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
-                           subF)
-
-    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
-      call mech_RGC_partitionDeformation(&
-                          crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
-                          subF,&
-                          ip, &
-                          el)
-  end select chosenHomogenization
-
-end subroutine partitionDeformation
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief update the internal state of the homogenization scheme and tell whether "done" and
-!> "happy" with result
-!--------------------------------------------------------------------------------------------------
-function updateState(subdt,subF,ip,el)
-
-  real(pReal), intent(in) :: &
-    subdt                                                                                           !< current time step
-  real(pReal), intent(in), dimension(3,3) :: &
-    subF
-  integer,     intent(in) :: &
-    ip, &                                                                                           !< integration point
-    el                                                                                              !< element number
-  integer :: c
-  logical, dimension(2) :: updateState
-  real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
-
-  updateState = .true.
-  chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
-    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
-      do c=1,homogenization_Nconstituents(material_homogenizationAt(el))
-        dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el)
-      enddo
-      updateState = &
-        updateState .and. &
-          mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
-                        crystallite_partitionedF(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
-                        crystallite_partitionedF0(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el),&
-                               subF,&
-                               subdt, &
-                               dPdFs, &
-                               ip, &
-                               el)
-  end select chosenHomogenization
-
-  chosenThermal: select case (thermal_type(material_homogenizationAt(el)))
-    case (THERMAL_adiabatic_ID) chosenThermal
-      updateState = &
-        updateState .and. &
-        thermal_adiabatic_updateState(subdt, &
-                                      ip, &
-                                      el)
-  end select chosenThermal
-
-  chosenDamage: select case (damage_type(material_homogenizationAt(el)))
-    case (DAMAGE_local_ID) chosenDamage
-      updateState = &
-        updateState .and. &
-        damage_local_updateState(subdt, &
-                                 ip, &
-                                 el)
-  end select chosenDamage
-
-end function updateState
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief derive average stress and stiffness from constituent quantities
-!--------------------------------------------------------------------------------------------------
-subroutine averageStressAndItsTangent(ip,el)
-
-  integer, intent(in) :: &
-    ip, &                                                                                           !< integration point
-    el                                                                                              !< element number
-  integer :: c
-  real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
- 
-  
-  chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
-    case (HOMOGENIZATION_NONE_ID) chosenHomogenization
-        homogenization_P(1:3,1:3,ip,el)            = crystallite_P(1:3,1:3,1,ip,el)
-        homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el) = crystallite_stressTangent(1,ip,el)
-
-    case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
-      do c = 1, homogenization_Nconstituents(material_homogenizationAt(el))
-        dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el)
-      enddo
-      call mech_isostrain_averageStressAndItsTangent(&
-        homogenization_P(1:3,1:3,ip,el), &
-        homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),&
-        crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
-        dPdFs, &
-        homogenization_typeInstance(material_homogenizationAt(el)))
-
-    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
-      do c = 1, homogenization_Nconstituents(material_homogenizationAt(el))
-        dPdFs(:,:,:,:,c) = crystallite_stressTangent(c,ip,el)
-      enddo
-      call mech_RGC_averageStressAndItsTangent(&
-        homogenization_P(1:3,1:3,ip,el), &
-        homogenization_dPdF(1:3,1:3,1:3,1:3,ip,el),&
-        crystallite_P(1:3,1:3,1:homogenization_Nconstituents(material_homogenizationAt(el)),ip,el), &
-        dPdFs, &
-        homogenization_typeInstance(material_homogenizationAt(el)))
-  end select chosenHomogenization
-
-end subroutine averageStressAndItsTangent
-
-
 !--------------------------------------------------------------------------------------------------
 !> @brief writes homogenization results to HDF5 output file
 !--------------------------------------------------------------------------------------------------
 subroutine homogenization_results
-  use material, only: &
-    material_homogenization_type => homogenization_type
 
-  integer :: p
+  integer :: ho
   character(len=:), allocatable :: group_base,group
 
-  !real(pReal), dimension(:,:,:), allocatable :: temp
 
-  do p=1,size(material_name_homogenization)
+  call results_closeGroup(results_addGroup('current/homogenization/'))
-    group_base = 'current/homogenization/'//trim(material_name_homogenization(p))
+
+  do ho=1,size(material_name_homogenization)
+    group_base = 'current/homogenization/'//trim(material_name_homogenization(ho))
     call results_closeGroup(results_addGroup(group_base))
 
-    group = trim(group_base)//'/generic'
+    call mech_results(group_base,ho)
-    call results_closeGroup(results_addGroup(group))
-    !temp = reshape(homogenization_F,[3,3,discretization_nIPs*discretization_Nelems])
-    !call results_writeDataset(group,temp,'F',&
-    !                          'deformation gradient','1')
-    !temp = reshape(homogenization_P,[3,3,discretization_nIPs*discretization_Nelems])
-    !call results_writeDataset(group,temp,'P',&
-    !                          '1st Piola-Kirchhoff stress','Pa')
-
-    group = trim(group_base)//'/mech'
-    call results_closeGroup(results_addGroup(group))
-    select case(material_homogenization_type(p))
-      case(HOMOGENIZATION_rgc_ID)
-        call mech_RGC_results(homogenization_typeInstance(p),group)
-    end select
 
     group = trim(group_base)//'/damage'
     call results_closeGroup(results_addGroup(group))
-    select case(damage_type(p))
+    select case(damage_type(ho))
-      case(DAMAGE_LOCAL_ID)
-        call damage_local_results(p,group)
       case(DAMAGE_NONLOCAL_ID)
-        call damage_nonlocal_results(p,group)
+        call damage_nonlocal_results(ho,group)
     end select
 
     group = trim(group_base)//'/thermal'
     call results_closeGroup(results_addGroup(group))
-    select case(thermal_type(p))
+    select case(thermal_type(ho))
-      case(THERMAL_ADIABATIC_ID)
-        call thermal_adiabatic_results(p,group)
       case(THERMAL_CONDUCTION_ID)
-        call thermal_conduction_results(p,group)
+        call thermal_conduction_results(ho,group)
     end select
 
  enddo
 
 end subroutine homogenization_results
 
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Forward data after successful increment.
+! ToDo: Any guessing for the current states possible?
+!--------------------------------------------------------------------------------------------------
+subroutine homogenization_forward
+
+  integer :: ho
+
+
+  do ho = 1, size(material_name_homogenization)
+    homogState (ho)%state0 = homogState (ho)%state
+    damageState_h(ho)%state0 = damageState_h(ho)%state
+  enddo
+
+end subroutine homogenization_forward
+
+
+!--------------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
+subroutine homogenization_restartWrite(fileHandle)
+
+  integer(HID_T), intent(in) :: fileHandle
+
+  integer(HID_T), dimension(2) :: groupHandle
+  integer :: ho
+
+
+  groupHandle(1) = HDF5_addGroup(fileHandle,'homogenization')
+
+  do ho = 1, size(material_name_homogenization)
+
+    groupHandle(2) = HDF5_addGroup(groupHandle(1),material_name_homogenization(ho))
+
+    call HDF5_read(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech
+
+    call HDF5_closeGroup(groupHandle(2))
+
+  enddo
+
+  call HDF5_closeGroup(groupHandle(1))
+
+end subroutine homogenization_restartWrite
+
+
+!--------------------------------------------------------------------------------------------------
+!--------------------------------------------------------------------------------------------------
+subroutine homogenization_restartRead(fileHandle)
+
+  integer(HID_T), intent(in) :: fileHandle
+
+  integer(HID_T), dimension(2) :: groupHandle
+  integer :: ho
+
+
+  groupHandle(1) = HDF5_openGroup(fileHandle,'homogenization')
+
+  do ho = 1, size(material_name_homogenization)
+
+    groupHandle(2) = HDF5_openGroup(groupHandle(1),material_name_homogenization(ho))
+
+    call HDF5_write(groupHandle(2),homogState(ho)%state,'omega') ! ToDo: should be done by mech
+
+    call HDF5_closeGroup(groupHandle(2))
+
+  enddo
+
+  call HDF5_closeGroup(groupHandle(1))
+
+end subroutine homogenization_restartRead
+
+
 end module homogenization

src/homogenization_mech.f90

@@ -0,0 +1,256 @@
+!--------------------------------------------------------------------------------------------------
+!> @author Martin Diehl, KU Leuven
+!> @brief Partition F and homogenize P/dPdF
+!--------------------------------------------------------------------------------------------------
+submodule(homogenization) homogenization_mech
+
+
+  interface
+
+    module subroutine mech_none_init
+    end subroutine mech_none_init
+
+    module subroutine mech_isostrain_init
+    end subroutine mech_isostrain_init
+
+    module subroutine mech_RGC_init(num_homogMech)
+      class(tNode), pointer, intent(in) :: &
+        num_homogMech                                                                               !< pointer to mechanical homogenization numerics data
+    end subroutine mech_RGC_init
+
+
+    module subroutine mech_isostrain_partitionDeformation(F,avgF)
+      real(pReal),   dimension (:,:,:), intent(out) :: F                                            !< partitioned deformation gradient
+      real(pReal),   dimension (3,3),   intent(in)  :: avgF                                         !< average deformation gradient at material point
+    end subroutine mech_isostrain_partitionDeformation
+
+    module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
+      real(pReal),   dimension (:,:,:), intent(out) :: F                                            !< partitioned deformation gradient
+      real(pReal),   dimension (3,3),   intent(in)  :: avgF                                         !< average deformation gradient at material point
+      integer,                          intent(in)  :: &
+        instance, &
+        of
+    end subroutine mech_RGC_partitionDeformation
+
+
+    module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
+      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 (:,:,:),     intent(in)  :: P                                        !< partitioned stresses
+      real(pReal),   dimension (:,:,:,:,:), intent(in)  :: dPdF                                     !< partitioned stiffnesses
+      integer,                              intent(in)  :: instance
+    end subroutine mech_isostrain_averageStressAndItsTangent
+
+    module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
+      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 (:,:,:),     intent(in)  :: P                                        !< partitioned stresses
+      real(pReal),   dimension (:,:,:,:,:), intent(in)  :: dPdF                                     !< partitioned stiffnesses
+      integer,                              intent(in)  :: instance
+    end subroutine mech_RGC_averageStressAndItsTangent
+
+
+    module function mech_RGC_updateState(P,F,avgF,dt,dPdF,ip,el) result(doneAndHappy)
+      logical, dimension(2) :: doneAndHappy
+      real(pReal), dimension(:,:,:),     intent(in)    :: &
+        P,&                                                                                         !< partitioned stresses
+        F                                                                                           !< partitioned deformation gradients
+      real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF                                         !< partitioned stiffnesses
+      real(pReal), dimension(3,3),       intent(in) :: avgF                                         !< average F
+      real(pReal),                       intent(in) :: dt                                           !< time increment
+      integer,                           intent(in) :: &
+        ip, &                                                                                       !< integration point number
+        el                                                                                          !< element number
+    end function mech_RGC_updateState
+
+
+    module subroutine mech_RGC_results(instance,group)
+      integer,          intent(in) :: instance                                                      !< homogenization instance
+      character(len=*), intent(in) :: group                                                         !< group name in HDF5 file
+    end subroutine mech_RGC_results
+
+  end interface
+
+contains
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Allocate variables and set parameters.
+!--------------------------------------------------------------------------------------------------
+module subroutine mech_init(num_homog)
+
+  class(tNode), pointer, intent(in) :: &
+    num_homog
+
+  class(tNode), pointer :: &
+    num_homogMech
+
+  print'(/,a)',   ' <<<+-  homogenization_mech init  -+>>>'
+
+  allocate(homogenization_dPdF(3,3,3,3,discretization_nIPs*discretization_Nelems), source=0.0_pReal)
+  homogenization_F0 = spread(math_I3,3,discretization_nIPs*discretization_Nelems)                   ! initialize to identity
+  homogenization_F = homogenization_F0                                                              ! initialize to identity
+  allocate(homogenization_P(3,3,discretization_nIPs*discretization_Nelems),        source=0.0_pReal)
+
+  num_homogMech => num_homog%get('mech',defaultVal=emptyDict)
+  if (any(homogenization_type == HOMOGENIZATION_NONE_ID))      call mech_none_init
+  if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init
+  if (any(homogenization_type == HOMOGENIZATION_RGC_ID))       call mech_RGC_init(num_homogMech)
+
+end subroutine mech_init
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Partition F onto the individual constituents.
+!--------------------------------------------------------------------------------------------------
+module subroutine mech_partition(subF,ip,el)
+
+  real(pReal), intent(in), dimension(3,3) :: &
+    subF
+  integer,     intent(in) :: &
+    ip, &                                                                                           !< integration point
+    el                                                                                              !< element number
+
+  integer :: co
+  real(pReal), dimension (3,3,homogenization_Nconstituents(material_homogenizationAt(el))) :: Fs
+
+
+  chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
+
+    case (HOMOGENIZATION_NONE_ID) chosenHomogenization
+      Fs(1:3,1:3,1) = subF
+
+    case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
+      call mech_isostrain_partitionDeformation(Fs,subF)
+
+    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
+      call mech_RGC_partitionDeformation(Fs,subF,ip,el)
+
+  end select chosenHomogenization
+
+  do co = 1,homogenization_Nconstituents(material_homogenizationAt(el))
+    call constitutive_mech_setF(Fs(1:3,1:3,co),co,ip,el)
+  enddo
+
+
+end subroutine mech_partition
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Average P and dPdF from the individual constituents.
+!--------------------------------------------------------------------------------------------------
+module subroutine mech_homogenize(dt,ip,el)
+
+  real(pReal), intent(in) :: dt
+  integer, intent(in) :: &
+       ip, &                                                                                        !< integration point
+       el                                                                                           !< element number
+
+  integer :: co,ce
+  real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
+  real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
+
+
+  ce = (el-1)* discretization_nIPs + ip
+  chosenHomogenization: select case(homogenization_type(material_homogenizationAt(el)))
+
+    case (HOMOGENIZATION_NONE_ID) chosenHomogenization
+        homogenization_P(1:3,1:3,ce)            = constitutive_mech_getP(1,ip,el)
+        homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = constitutive_mech_dPdF(dt,1,ip,el)
+
+    case (HOMOGENIZATION_ISOSTRAIN_ID) chosenHomogenization
+      do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
+        dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el)
+        Ps(:,:,co) = constitutive_mech_getP(co,ip,el)
+      enddo
+      call mech_isostrain_averageStressAndItsTangent(&
+        homogenization_P(1:3,1:3,ce), &
+        homogenization_dPdF(1:3,1:3,1:3,1:3,ce),&
+        Ps,dPdFs, &
+        homogenization_typeInstance(material_homogenizationAt(el)))
+
+    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
+      do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
+        dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(dt,co,ip,el)
+        Ps(:,:,co) = constitutive_mech_getP(co,ip,el)
+      enddo
+      call mech_RGC_averageStressAndItsTangent(&
+        homogenization_P(1:3,1:3,ce), &
+        homogenization_dPdF(1:3,1:3,1:3,1:3,ce),&
+        Ps,dPdFs, &
+        homogenization_typeInstance(material_homogenizationAt(el)))
+
+  end select chosenHomogenization
+
+end subroutine mech_homogenize
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief update the internal state of the homogenization scheme and tell whether "done" and
+!> "happy" with result
+!--------------------------------------------------------------------------------------------------
+module function mech_updateState(subdt,subF,ip,el) result(doneAndHappy)
+
+  real(pReal), intent(in) :: &
+    subdt                                                                                           !< current time step
+  real(pReal), intent(in), dimension(3,3) :: &
+    subF
+  integer,     intent(in) :: &
+    ip, &                                                                                           !< integration point
+    el                                                                                              !< element number
+  logical, dimension(2) :: doneAndHappy
+
+  integer :: co
+  real(pReal) :: dPdFs(3,3,3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
+  real(pReal) :: Fs(3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
+  real(pReal) :: Ps(3,3,homogenization_Nconstituents(material_homogenizationAt(el)))
+
+
+  if (homogenization_type(material_homogenizationAt(el)) == HOMOGENIZATION_RGC_ID) then
+      do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
+        dPdFs(:,:,:,:,co) = constitutive_mech_dPdF(subdt,co,ip,el)
+        Fs(:,:,co)        = constitutive_mech_getF(co,ip,el)
+        Ps(:,:,co)        = constitutive_mech_getP(co,ip,el)
+      enddo
+      doneAndHappy = mech_RGC_updateState(Ps,Fs,subF,subdt,dPdFs,ip,el)
+  else
+    doneAndHappy = .true.
+  endif
+
+end function mech_updateState
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Write results to file.
+!--------------------------------------------------------------------------------------------------
+module subroutine mech_results(group_base,h)
+  use material, only: &
+    material_homogenization_type => homogenization_type
+
+  character(len=*), intent(in) :: group_base
+  integer, intent(in)          :: h
+
+  character(len=:), allocatable :: group
+
+  group = trim(group_base)//'/mech'
+  call results_closeGroup(results_addGroup(group))
+
+  select case(material_homogenization_type(h))
+
+    case(HOMOGENIZATION_rgc_ID)
+      call mech_RGC_results(homogenization_typeInstance(h),group)
+
+  end select
+
+  !temp = reshape(homogenization_F,[3,3,discretization_nIPs*discretization_Nelems])
+  !call results_writeDataset(group,temp,'F',&
+  !                          'deformation gradient','1')
+  !temp = reshape(homogenization_P,[3,3,discretization_nIPs*discretization_Nelems])
+  !call results_writeDataset(group,temp,'P',&
+  !                          '1st Piola-Kirchhoff stress','Pa')
+
+end subroutine mech_results
+
+
+end submodule homogenization_mech

src/homogenization_mech_RGC.f90

@@ -6,8 +6,9 @@
 !> @brief Relaxed grain cluster (RGC) homogenization scheme
 !> N_constituents is defined as p x q x r (cluster)
 !--------------------------------------------------------------------------------------------------
-submodule(homogenization) homogenization_mech_RGC
+submodule(homogenization:homogenization_mech) homogenization_mech_RGC
   use rotations
+  use lattice
 
   type :: tParameters
     integer, dimension(:), allocatable :: &
@@ -18,16 +19,11 @@ submodule(homogenization) homogenization_mech_RGC
     real(pReal), dimension(:), allocatable :: &
       D_alpha, &
       a_g
-    integer :: &
-      of_debug = 0
     character(len=pStringLen), allocatable, dimension(:) :: &
       output
   end type tParameters
 
   type :: tRGCstate
-    real(pReal), pointer,     dimension(:) :: &
-      work, &
-      penaltyEnergy
     real(pReal), pointer,     dimension(:,:) :: &
       relaxationVector
   end type tRGCstate
@@ -151,12 +147,6 @@ module subroutine mech_RGC_init(num_homogMech)
               st0 => state0(homogenization_typeInstance(h)), &
               dst => dependentState(homogenization_typeInstance(h)))
 
-#ifdef DEBUG
-    if  (h==material_homogenizationAt(debugHomog%element)) then
-      prm%of_debug = material_homogenizationMemberAt(debugHomog%ip,debugHomog%element)
-    endif
-#endif
-
 #if defined (__GFORTRAN__)
     prm%output = output_asStrings(homogMech)
 #else
@@ -177,8 +167,7 @@ module subroutine mech_RGC_init(num_homogMech)
     nIntFaceTot = 3*(  (prm%N_constituents(1)-1)*prm%N_constituents(2)*prm%N_constituents(3) &
                       + prm%N_constituents(1)*(prm%N_constituents(2)-1)*prm%N_constituents(3) &
                       + prm%N_constituents(1)*prm%N_constituents(2)*(prm%N_constituents(3)-1))
-    sizeState = nIntFaceTot &
+    sizeState = nIntFaceTot
-              + size(['avg constitutive work ','average penalty energy'])
 
     homogState(h)%sizeState = sizeState
     allocate(homogState(h)%state0   (sizeState,Nmaterialpoints), source=0.0_pReal)
@@ -187,8 +176,6 @@ module subroutine mech_RGC_init(num_homogMech)
 
     stt%relaxationVector   => homogState(h)%state(1:nIntFaceTot,:)
     st0%relaxationVector   => homogState(h)%state0(1:nIntFaceTot,:)
-    stt%work               => homogState(h)%state(nIntFaceTot+1,:)
-    stt%penaltyEnergy      => homogState(h)%state(nIntFaceTot+2,:)
 
     allocate(dst%volumeDiscrepancy(   Nmaterialpoints), source=0.0_pReal)
     allocate(dst%relaxationRate_avg(  Nmaterialpoints), source=0.0_pReal)
@@ -239,17 +226,6 @@ module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
         F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j)                                           ! calculating deformation relaxations due to interface relaxation
     enddo
     F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF                                                    ! resulting relaxed deformation gradient
-
-#ifdef DEBUG
-    if (debugHomog%extensive) then
-      print'(a,i3)',' Deformation gradient of grain: ',iGrain
-      do i = 1,3
-        print'(1x,3(e15.8,1x))',(F(i,j,iGrain), j = 1,3)
-      enddo
-      print*,' '
-      flush(IO_STDOUT)
-    endif
-#endif
   enddo
 
   end associate
@@ -261,7 +237,17 @@ end subroutine mech_RGC_partitionDeformation
 !> @brief update the internal state of the homogenization scheme and tell whether "done" and
 ! "happy" with result
 !--------------------------------------------------------------------------------------------------
-module procedure mech_RGC_updateState
+module function mech_RGC_updateState(P,F,avgF,dt,dPdF,ip,el) result(doneAndHappy)
+      logical, dimension(2) :: doneAndHappy
+      real(pReal), dimension(:,:,:),     intent(in)    :: &
+        P,&                                                                                         !< partitioned stresses
+        F                                                                                           !< partitioned deformation gradients
+      real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF                                         !< partitioned stiffnesses
+      real(pReal), dimension(3,3),       intent(in) :: avgF                                         !< average F
+      real(pReal),                       intent(in) :: dt                                           !< time increment
+      integer,                           intent(in) :: &
+        ip, &                                                                                       !< integration point number
+        el                                                                                          !< element number
 
   integer, dimension(4) :: intFaceN,intFaceP,faceID
   integer, dimension(3) :: nGDim,iGr3N,iGr3P
@@ -273,13 +259,9 @@ module procedure mech_RGC_updateState
   logical :: error
   real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix
   real(pReal), dimension(:), allocatable   :: resid,relax,p_relax,p_resid,drelax
-#ifdef DEBUG
-  integer, dimension(3) :: stresLoc
-  integer, dimension(2) :: residLoc
-#endif
 
   zeroTimeStep: if(dEq0(dt)) then
-    mech_RGC_updateState = .true.                                                                   ! pretend everything is fine and return
+    doneAndHappy = .true.                                                                   ! pretend everything is fine and return
     return
   endif zeroTimeStep
 
@@ -298,21 +280,11 @@ module procedure mech_RGC_updateState
 
 !--------------------------------------------------------------------------------------------------
 ! allocate the size of the global relaxation arrays/jacobian matrices depending on the size of the cluster
-  allocate(resid(3*nIntFaceTot),   source=0.0_pReal)
+  allocate(resid(3*nIntFaceTot), source=0.0_pReal)
-  allocate(tract(nIntFaceTot,3),        source=0.0_pReal)
+  allocate(tract(nIntFaceTot,3), source=0.0_pReal)
   relax  = stt%relaxationVector(:,of)
   drelax = stt%relaxationVector(:,of) - st0%relaxationVector(:,of)
 
-#ifdef DEBUG
-  if (debugHomog%extensive) then
-    print*, 'Obtained state: '
-    do i = 1,size(stt%relaxationVector(:,of))
-      print'(1x,2(e15.8,1x))', stt%relaxationVector(i,of)
-    enddo
-    print*,' '
-  endif
-#endif
-
 !--------------------------------------------------------------------------------------------------
 ! computing interface mismatch and stress penalty tensor for all interfaces of all grains
   call stressPenalty(R,NN,avgF,F,ip,el,instance,of)
@@ -353,13 +325,6 @@ module procedure mech_RGC_updateState
       enddo
     enddo
 
-#ifdef DEBUG
-    if (debugHomog%extensive) then
-      print'(a,i3)',' Traction at interface: ',iNum
-      print'(1x,3(e15.8,1x))',(tract(iNum,j), j = 1,3)
-      print*,' '
-    endif
-#endif
   enddo
 
 !--------------------------------------------------------------------------------------------------
@@ -367,80 +332,25 @@ module procedure mech_RGC_updateState
   stresMax = maxval(abs(P))                                                                         ! get the maximum of first Piola-Kirchhoff (material) stress
   residMax = maxval(abs(tract))                                                                     ! get the maximum of the residual
 
-#ifdef DEBUG
+  doneAndHappy = .false.
-  if (debugHomog%extensive .and. prm%of_debug == of) then
-    stresLoc = maxloc(abs(P))
-    residLoc = maxloc(abs(tract))
-    print'(a,i2,1x,i4)',' RGC residual check ... ',ip,el
-    print'(a,e15.8,a,i3,a,i2,i2)', ' Max stress: ',stresMax, &
-               '@ grain ',stresLoc(3),' in component ',stresLoc(1),stresLoc(2)
-    print'(a,e15.8,a,i3,a,i2)',' Max residual: ',residMax, &
-               ' @ iface ',residLoc(1),' in direction ',residLoc(2)
-    flush(IO_STDOUT)
-  endif
-#endif
-
-  mech_RGC_updateState = .false.
 
 !--------------------------------------------------------------------------------------------------
 !  If convergence reached => done and happy
   if (residMax < num%rtol*stresMax .or. residMax < num%atol) then
-    mech_RGC_updateState = .true.
+    doneAndHappy = .true.
-#ifdef DEBUG
-    if (debugHomog%extensive .and. prm%of_debug == of) &
-      print*, '... done and happy'; flush(IO_STDOUT)
-#endif
-
-!--------------------------------------------------------------------------------------------------
-! compute/update the state for postResult, i.e., all energy densities computed by time-integration
-    do iGrain = 1,product(prm%N_constituents)
-      do i = 1,3;do j = 1,3
-        stt%work(of)          = stt%work(of) &
-                              + P(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal)
-        stt%penaltyEnergy(of) = stt%penaltyEnergy(of) &
-                              + R(i,j,iGrain)*(F(i,j,iGrain) - F0(i,j,iGrain))/real(nGrain,pReal)
-      enddo; enddo
-    enddo
 
     dst%mismatch(1:3,of)       = sum(NN,2)/real(nGrain,pReal)
     dst%relaxationRate_avg(of) = sum(abs(drelax))/dt/real(3*nIntFaceTot,pReal)
     dst%relaxationRate_max(of) = maxval(abs(drelax))/dt
 
-#ifdef DEBUG
-    if (debugHomog%extensive .and. prm%of_debug == of) then
-      print'(a,e15.8)',       ' Constitutive work: ',stt%work(of)
-      print'(a,3(1x,e15.8))', ' Magnitude mismatch: ',dst%mismatch(1,of), &
-                                                      dst%mismatch(2,of), &
-                                                      dst%mismatch(3,of)
-      print'(a,e15.8)',   ' Penalty energy: ',          stt%penaltyEnergy(of)
-      print'(a,e15.8,/)', ' Volume discrepancy: ',      dst%volumeDiscrepancy(of)
-      print'(a,e15.8)',   ' Maximum relaxation rate: ', dst%relaxationRate_max(of)
-      print'(a,e15.8,/)', ' Average relaxation rate: ', dst%relaxationRate_avg(of)
-      flush(IO_STDOUT)
-    endif
-#endif
-
     return
 
 !--------------------------------------------------------------------------------------------------
 ! if residual blows-up => done but unhappy
   elseif (residMax > num%relMax*stresMax .or. residMax > num%absMax) then                           ! try to restart when residual blows up exceeding maximum bound
-    mech_RGC_updateState = [.true.,.false.]                                                         ! with direct cut-back
+    doneAndHappy = [.true.,.false.]                                                         ! with direct cut-back
-
-#ifdef DEBUG
-    if (debugHomog%extensive .and. prm%of_debug == of) &
-      print'(a,/)', ' ... broken'; flush(IO_STDOUT)
-#endif
-
    return
-
+  endif
- else                                                                                               ! proceed with computing the Jacobian and state update
-#ifdef DEBUG
-   if (debugHomog%extensive .and. prm%of_debug == of) &
-     print'(a,/)', ' ... not yet done'; flush(IO_STDOUT)
-#endif
-
- endif
 
 !---------------------------------------------------------------------------------------------------
 ! construct the global Jacobian matrix for updating the global relaxation vector array when
@@ -492,17 +402,6 @@ module procedure mech_RGC_updateState
     enddo
   enddo
 
-#ifdef DEBUG
-  if (debugHomog%extensive) then
-    print*, 'Jacobian matrix of stress'
-    do i = 1,3*nIntFaceTot
-      print'(1x,100(e11.4,1x))',(smatrix(i,j), j = 1,3*nIntFaceTot)
-    enddo
-    print*,' '
-    flush(IO_STDOUT)
-  endif
-#endif
-
 !--------------------------------------------------------------------------------------------------
 ! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical
 ! perturbation method) "pmatrix"
@@ -552,16 +451,6 @@ module procedure mech_RGC_updateState
     pmatrix(:,ipert) = p_resid/num%pPert
   enddo
 
-#ifdef DEBUG
-  if (debugHomog%extensive) then
-    print*, 'Jacobian matrix of penalty'
-    do i = 1,3*nIntFaceTot
-      print'(1x,100(e11.4,1x))',(pmatrix(i,j), j = 1,3*nIntFaceTot)
-    enddo
-    print*,' '
-    flush(IO_STDOUT)
-  endif
-#endif
 
 !--------------------------------------------------------------------------------------------------
 ! ... of the numerical viscosity traction "rmatrix"
@@ -571,48 +460,16 @@ module procedure mech_RGC_updateState
                    (abs(drelax(i))/(num%refRelaxRate*dt))**(num%viscPower - 1.0_pReal)              ! only in the main diagonal term
   enddo
 
-#ifdef DEBUG
-  if (debugHomog%extensive) then
-    print*, 'Jacobian matrix of penalty'
-    do i = 1,3*nIntFaceTot
-      print'(1x,100(e11.4,1x))',(rmatrix(i,j), j = 1,3*nIntFaceTot)
-    enddo
-    print*,' '
-    flush(IO_STDOUT)
-  endif
-#endif
 
 !--------------------------------------------------------------------------------------------------
 ! The overall Jacobian matrix summarizing contributions of smatrix, pmatrix, rmatrix
   allocate(jmatrix(3*nIntFaceTot,3*nIntFaceTot)); jmatrix = smatrix + pmatrix + rmatrix
 
-#ifdef DEBUG
-  if (debugHomog%extensive) then
-    print*, 'Jacobian matrix (total)'
-    do i = 1,3*nIntFaceTot
-      print'(1x,100(e11.4,1x))',(jmatrix(i,j), j = 1,3*nIntFaceTot)
-    enddo
-    print*,' '
-    flush(IO_STDOUT)
-  endif
-#endif
-
 !--------------------------------------------------------------------------------------------------
 ! computing the update of the state variable (relaxation vectors) using the Jacobian matrix
   allocate(jnverse(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal)
   call math_invert(jnverse,error,jmatrix)
 
-#ifdef DEBUG
-  if (debugHomog%extensive) then
-    print*, 'Jacobian inverse'
-    do i = 1,3*nIntFaceTot
-      print'(1x,100(e11.4,1x))',(jnverse(i,j), j = 1,3*nIntFaceTot)
-    enddo
-    print*,' '
-    flush(IO_STDOUT)
-  endif
-#endif
-
 !--------------------------------------------------------------------------------------------------
 ! calculate the state update (global relaxation vectors) for the next Newton-Raphson iteration
   drelax = 0.0_pReal
@@ -621,7 +478,7 @@ module procedure mech_RGC_updateState
   enddo; enddo
   stt%relaxationVector(:,of) = relax + drelax                                                       ! Updateing the state variable for the next iteration
   if (any(abs(drelax) > num%maxdRelax)) then                                                        ! Forcing cutback when the incremental change of relaxation vector becomes too large
-    mech_RGC_updateState = [.true.,.false.]
+    doneAndHappy = [.true.,.false.]
     !$OMP CRITICAL (write2out)
     print'(a,i3,a,i3,a)',' RGC_updateState: ip ',ip,' | el ',el,' enforces cutback'
     print'(a,e15.8)',' due to large relaxation change = ',maxval(abs(drelax))
@@ -629,17 +486,6 @@ module procedure mech_RGC_updateState
     !$OMP END CRITICAL (write2out)
   endif
 
-#ifdef DEBUG
-  if (debugHomog%extensive) then
-    print*, 'Returned state: '
-    do i = 1,size(stt%relaxationVector(:,of))
-      print'(1x,2(e15.8,1x))', stt%relaxationVector(i,of)
-    enddo
-    print*,' '
-    flush(IO_STDOUT)
-  endif
-#endif
-
   end associate
 
   contains
@@ -659,10 +505,11 @@ module procedure mech_RGC_updateState
     integer, dimension (3)   :: iGrain3,iGNghb3,nGDim
     real(pReal),   dimension (3,3) :: gDef,nDef
     real(pReal),   dimension (3)   :: nVect,surfCorr
-    real(pReal),   dimension (2)   :: Gmoduli
     integer :: iGrain,iGNghb,iFace,i,j,k,l
-    real(pReal)   :: muGrain,muGNghb,nDefNorm,bgGrain,bgGNghb
+    real(pReal) :: muGrain,muGNghb,nDefNorm
-    real(pReal), parameter  :: nDefToler = 1.0e-10_pReal
+    real(pReal), parameter  :: &
+      nDefToler = 1.0e-10_pReal, &
+      b = 2.5e-10_pReal                                                                             ! Length of Burgers vector
 
     nGDim = param(instance)%N_constituents
     rPen = 0.0_pReal
@@ -676,19 +523,11 @@ module procedure mech_RGC_updateState
 
     associate(prm => param(instance))
 
-#ifdef DEBUG
-    if (debugHomog%extensive .and. prm%of_debug == of) then
-      print'(a,2(1x,i3))', ' Correction factor: ',ip,el
-      print*, surfCorr
-    endif
-#endif
 
    !-----------------------------------------------------------------------------------------------
    ! computing the mismatch and penalty stress tensor of all grains
    grainLoop: do iGrain = 1,product(prm%N_constituents)
-     Gmoduli = equivalentModuli(iGrain,ip,el)
+     muGrain = equivalentMu(iGrain,ip,el)
-     muGrain = Gmoduli(1)                                                                           ! collecting the equivalent shear modulus of grain
-     bgGrain = Gmoduli(2)                                                                           ! and the lengthh of Burgers vector
      iGrain3 = grain1to3(iGrain,prm%N_constituents)                                                 ! get the grain ID in local 3-dimensional index (x,y,z)-position
 
      interfaceLoop: do iFace = 1,6
@@ -700,9 +539,7 @@ module procedure mech_RGC_updateState
        where(iGNghb3 < 1)    iGNghb3 = nGDim
        where(iGNghb3 >nGDim) iGNghb3 = 1
        iGNghb  = grain3to1(iGNghb3,prm%N_constituents)                                              ! get the ID of the neighboring grain
-       Gmoduli = equivalentModuli(iGNghb,ip,el)                                                     ! collect the shear modulus and Burgers vector of the neighbor
+       muGNghb = equivalentMu(iGNghb,ip,el)
-       muGNghb = Gmoduli(1)
-       bgGNghb = Gmoduli(2)
        gDef = 0.5_pReal*(fDef(1:3,1:3,iGNghb) - fDef(1:3,1:3,iGrain))                               ! difference/jump in deformation gradeint across the neighbor
 
        !-------------------------------------------------------------------------------------------
@@ -717,30 +554,19 @@ module procedure mech_RGC_updateState
        enddo; enddo
        nDefNorm = max(nDefToler,sqrt(nDefNorm))                                                     ! approximation to zero mismatch if mismatch is zero (singularity)
        nMis(abs(intFace(1)),iGrain) = nMis(abs(intFace(1)),iGrain) + nDefNorm                       ! total amount of mismatch experienced by the grain (at all six interfaces)
-#ifdef DEBUG
+
-       if (debugHomog%extensive .and. prm%of_debug == of) then
-         print'(a,i2,a,i3)',' Mismatch to face: ',intFace(1),' neighbor grain: ',iGNghb
-         print*, transpose(nDef)
-         print'(a,e11.4)', ' with magnitude: ',nDefNorm
-       endif
-#endif
 
        !-------------------------------------------------------------------------------------------
        ! compute the stress penalty of all interfaces
        do i = 1,3; do j = 1,3; do k = 1,3; do l = 1,3
-         rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*bgGrain + muGNghb*bgGNghb)*prm%xi_alpha &
+         rPen(i,j,iGrain) = rPen(i,j,iGrain) + 0.5_pReal*(muGrain*b + muGNghb*b)*prm%xi_alpha &
                                                 *surfCorr(abs(intFace(1)))/prm%D_alpha(abs(intFace(1))) &
                                                 *cosh(prm%c_alpha*nDefNorm) &
                                                 *0.5_pReal*nVect(l)*nDef(i,k)/nDefNorm*math_LeviCivita(k,l,j) &
                                                 *tanh(nDefNorm/num%xSmoo)
        enddo; enddo;enddo; enddo
      enddo interfaceLoop
-#ifdef DEBUG
+
-     if (debugHomog%extensive .and. prm%of_debug == of) then
-       print'(a,i2)', ' Penalty of grain: ',iGrain
-       print*, transpose(rPen(1:3,1:3,iGrain))
-     endif
-#endif
 
    enddo grainLoop
 
@@ -783,13 +609,6 @@ module procedure mech_RGC_updateState
       vPen(:,:,i) = -1.0_pReal/real(nGrain,pReal)*num%volDiscrMod*num%volDiscrPow/num%maxVolDiscr* &
                          sign((abs(vDiscrep)/num%maxVolDiscr)**(num%volDiscrPow - 1.0),vDiscrep)* &
                          gVol(i)*transpose(math_inv33(fDef(:,:,i)))
-
-#ifdef DEBUG
-      if (debugHomog%extensive .and. param(instance)%of_debug == of) then
-        print'(a,i2)',' Volume penalty of grain: ',i
-        print*, transpose(vPen(:,:,i))
-      endif
-#endif
     enddo
 
   end subroutine volumePenalty
@@ -827,44 +646,26 @@ module procedure mech_RGC_updateState
   end function surfaceCorrection
 
 
-  !--------------------------------------------------------------------------------------------------
+  !-------------------------------------------------------------------------------------------------
   !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor
-  !--------------------------------------------------------------------------------------------------
+  !-------------------------------------------------------------------------------------------------
-  function equivalentModuli(grainID,ip,el)
+  real(pReal) function equivalentMu(grainID,ip,el)
-
-    real(pReal), dimension(2)    :: equivalentModuli
 
     integer, intent(in)    :: &
       grainID,&
       ip, &                                                                                         !< integration point number
       el                                                                                            !< element number
-    real(pReal), dimension(6,6) :: elasTens
-    real(pReal) :: &
-      cEquiv_11, &
-      cEquiv_12, &
-      cEquiv_44
-
-    elasTens = constitutive_homogenizedC(grainID,ip,el)
-
-    !----------------------------------------------------------------------------------------------
-    ! compute the equivalent shear modulus after Turterltaub and Suiker, JMPS (2005)
-    cEquiv_11 = (elasTens(1,1) + elasTens(2,2) + elasTens(3,3))/3.0_pReal
-    cEquiv_12 = (elasTens(1,2) + elasTens(2,3) + elasTens(3,1) + &
-                 elasTens(1,3) + elasTens(2,1) + elasTens(3,2))/6.0_pReal
-    cEquiv_44 = (elasTens(4,4) + elasTens(5,5) + elasTens(6,6))/3.0_pReal
-    equivalentModuli(1) = 0.2_pReal*(cEquiv_11 - cEquiv_12) + 0.6_pReal*cEquiv_44
-
-    !----------------------------------------------------------------------------------------------
-    ! obtain the length of Burgers vector (could be model dependend)
-    equivalentModuli(2) = 2.5e-10_pReal
-
-  end function equivalentModuli
 
 
-  !--------------------------------------------------------------------------------------------------
+    equivalentMu = lattice_equivalent_mu(constitutive_homogenizedC(grainID,ip,el),'voigt')
+
+  end function equivalentMu
+
+
+  !-------------------------------------------------------------------------------------------------
   !> @brief calculating the grain deformation gradient (the same with
   ! homogenization_RGC_partitionDeformation, but used only for perturbation scheme)
-  !--------------------------------------------------------------------------------------------------
+  !-------------------------------------------------------------------------------------------------
   subroutine grainDeformation(F, avgF, instance, of)
 
     real(pReal),   dimension(:,:,:), intent(out) :: F                                               !< partitioned F  per grain
@@ -879,7 +680,7 @@ module procedure mech_RGC_updateState
     integer,       dimension(3) :: iGrain3
     integer :: iGrain,iFace,i,j
 
-    !-------------------------------------------------------------------------------------------------
+    !-----------------------------------------------------------------------------------------------
     ! compute the deformation gradient of individual grains due to relaxations
 
     associate(prm => param(instance))
@@ -901,7 +702,7 @@ module procedure mech_RGC_updateState
 
   end subroutine grainDeformation
 
-end procedure mech_RGC_updateState
+end function mech_RGC_updateState
 
 
 !--------------------------------------------------------------------------------------------------
@@ -935,15 +736,9 @@ module subroutine mech_RGC_results(instance,group)
   associate(stt => state(instance), dst => dependentState(instance), prm => param(instance))
   outputsLoop: do o = 1,size(prm%output)
     select case(trim(prm%output(o)))
-      case('W')
-        call results_writeDataset(group,stt%work,trim(prm%output(o)), &
-                                  'work density','J/m³')
       case('M')
         call results_writeDataset(group,dst%mismatch,trim(prm%output(o)), &
                                   'average mismatch tensor','1')
-      case('R')
-        call results_writeDataset(group,stt%penaltyEnergy,trim(prm%output(o)), &
-                                  'mismatch penalty density','J/m³')
       case('Delta_V')
         call results_writeDataset(group,dst%volumeDiscrepancy,trim(prm%output(o)), &
                                   'volume discrepancy','m³')

src/homogenization_mech_isostrain.f90

@@ -4,7 +4,7 @@
 !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
 !> @brief Isostrain (full constraint Taylor assuption) homogenization scheme
 !--------------------------------------------------------------------------------------------------
-submodule(homogenization) homogenization_mech_isostrain
+submodule(homogenization:homogenization_mech) homogenization_mech_isostrain
 
   enum, bind(c); enumerator :: &
     parallel_ID, &

src/homogenization_mech_none.f90

@@ -4,7 +4,7 @@
 !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
 !> @brief dummy homogenization homogenization scheme for 1 constituent per material point
 !--------------------------------------------------------------------------------------------------
-submodule(homogenization) homogenization_mech_none
+submodule(homogenization:homogenization_mech) homogenization_mech_none
 
 contains
 

src/homogenization_thermal.f90

@@ -0,0 +1,39 @@
+!--------------------------------------------------------------------------------------------------
+!> @author Martin Diehl, KU Leuven
+!--------------------------------------------------------------------------------------------------
+submodule(homogenization) homogenization_thermal
+
+
+contains
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Allocate variables and set parameters.
+!--------------------------------------------------------------------------------------------------
+module subroutine thermal_init()
+
+
+  print'(/,a)',   ' <<<+-  homogenization_thermal init  -+>>>'
+
+  allocate(homogenization_T(discretization_nIPs*discretization_Nelems))
+
+
+end subroutine thermal_init
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Partition T onto the individual constituents.
+!--------------------------------------------------------------------------------------------------
+module subroutine thermal_partition(T,ip,el)
+
+  real(pReal), intent(in) :: T
+  integer,     intent(in) :: &
+    ip, &                                                                                           !< integration point
+    el                                                                                              !< element number
+
+
+  call constitutive_thermal_setT(T,1,ip,el)
+
+end subroutine thermal_partition
+
+
+end submodule homogenization_thermal

src/kinematics_cleavage_opening.f90

@@ -99,10 +99,10 @@ end function kinematics_cleavage_opening_init
 !--------------------------------------------------------------------------------------------------
 !> @brief  contains the constitutive equation for calculating the velocity gradient
 !--------------------------------------------------------------------------------------------------
-module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
+module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el)
 
   integer, intent(in) :: &
-    ipc, &                                                                                          !< grain number
+    co, &                                                                                          !< grain number
     ip, &                                                                                           !< integration point number
     el                                                                                              !< element number
   real(pReal),   intent(in),  dimension(3,3) :: &
@@ -120,11 +120,11 @@ module subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S,
     udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt
 
   homog = material_homogenizationAt(el)
-  damageOffset = damageMapping(homog)%p(ip,el)
+  damageOffset = material_homogenizationMemberAt(ip,el)
 
   Ld = 0.0_pReal
   dLd_dTstar = 0.0_pReal
-  associate(prm => param(kinematics_cleavage_opening_instance(material_phaseAt(ipc,el))))
+  associate(prm => param(kinematics_cleavage_opening_instance(material_phaseAt(co,el))))
   do i = 1,prm%sum_N_cl
     traction_crit = prm%g_crit(i)* damage(homog)%p(damageOffset)**2.0_pReal
 

src/kinematics_slipplane_opening.f90

@@ -117,10 +117,10 @@ end function kinematics_slipplane_opening_init
 !--------------------------------------------------------------------------------------------------
 !> @brief  contains the constitutive equation for calculating the velocity gradient
 !--------------------------------------------------------------------------------------------------
-module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
+module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, co, ip, el)
 
   integer, intent(in) :: &
-    ipc, &                                                                                          !< grain number
+    co, &                                                                                          !< grain number
     ip, &                                                                                           !< integration point number
     el                                                                                              !< element number
   real(pReal),   intent(in),  dimension(3,3) :: &
@@ -138,10 +138,10 @@ module subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S
     traction_d, traction_t, traction_n, traction_crit, &
     udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt
 
-  phase = material_phaseAt(ipc,el)
+  phase = material_phaseAt(co,el)
   instance = kinematics_slipplane_opening_instance(phase)
   homog = material_homogenizationAt(el)
-  damageOffset = damageMapping(homog)%p(ip,el)
+  damageOffset = material_homogenizationMemberAt(ip,el)
 
   associate(prm => param(instance))
   Ld = 0.0_pReal

src/kinematics_thermal_expansion.f90

@@ -81,36 +81,13 @@ module function kinematics_thermal_expansion_init(kinematics_length) result(myKi
 end function kinematics_thermal_expansion_init
 
 
-!--------------------------------------------------------------------------------------------------
-!> @brief  report initial thermal strain based on current temperature deviation from reference
-!--------------------------------------------------------------------------------------------------
-pure module function kinematics_thermal_expansion_initialStrain(homog,phase,offset) result(initialStrain)
-
- integer, intent(in) :: &
-   phase, &
-   homog, &
-   offset
-
- real(pReal), dimension(3,3) :: &
-   initialStrain                                                                                    !< initial thermal strain (should be small strain, though)
-
- associate(prm => param(kinematics_thermal_expansion_instance(phase)))
- initialStrain = &
-   (temperature(homog)%p(offset) - prm%T_ref)**1 / 1. * prm%A(1:3,1:3,1) + &                        ! constant  coefficient
-   (temperature(homog)%p(offset) - prm%T_ref)**2 / 2. * prm%A(1:3,1:3,2) + &                        ! linear    coefficient
-   (temperature(homog)%p(offset) - prm%T_ref)**3 / 3. * prm%A(1:3,1:3,3)                            ! quadratic coefficient
- end associate
-
-end function kinematics_thermal_expansion_initialStrain
-
-
 !--------------------------------------------------------------------------------------------------
 !> @brief constitutive equation for calculating the velocity gradient
 !--------------------------------------------------------------------------------------------------
-module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el)
+module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, co, ip, el)
 
   integer, intent(in) :: &
-    ipc, &                                                                                          !< grain number
+    co, &                                                                                          !< grain number
     ip, &                                                                                           !< integration point number
     el                                                                                              !< element number
   real(pReal),   intent(out), dimension(3,3) :: &
@@ -124,10 +101,10 @@ module subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, i
   real(pReal) :: &
     T, TDot
 
-  phase = material_phaseAt(ipc,el)
+  phase = material_phaseAt(co,el)
   homog = material_homogenizationAt(el)
-  T = temperature(homog)%p(thermalMapping(homog)%p(ip,el))
+  T = temperature(homog)%p(material_homogenizationMemberAt(ip,el))
-  TDot = temperatureRate(homog)%p(thermalMapping(homog)%p(ip,el))
+  TDot = temperatureRate(homog)%p(material_homogenizationMemberAt(ip,el))
 
   associate(prm => param(kinematics_thermal_expansion_instance(phase)))
   Li = TDot * ( &

src/lattice.f90

@@ -421,6 +421,8 @@ module lattice
     lattice_BCT_ID, &
     lattice_HEX_ID, &
     lattice_ORT_ID, &
+    lattice_equivalent_nu, &
+    lattice_equivalent_mu, &
     lattice_applyLatticeSymmetry33, &
     lattice_SchmidMatrix_slip, &
     lattice_SchmidMatrix_twin, &
@@ -451,12 +453,13 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine lattice_init
 
-  integer :: Nphases, p,i
+  integer :: Nphases, ph,i
   class(tNode), pointer :: &
     phases, &
     phase, &
     mech, &
-    elasticity
+    elasticity, &
+    thermal
 
   print'(/,a)', ' <<<+-  lattice init  -+>>>'; flush(IO_STDOUT)
 
@@ -474,67 +477,71 @@ subroutine lattice_init
            lattice_mu, lattice_nu,&
            source=[(0.0_pReal,i=1,Nphases)])
 
-  do p = 1, phases%length
+  do ph = 1, phases%length
-    phase => phases%get(p)
+    phase => phases%get(ph)
     mech  => phase%get('mechanics')
     elasticity => mech%get('elasticity')
-    lattice_C66(1,1,p) = elasticity%get_asFloat('C_11')
+    lattice_C66(1,1,ph) = elasticity%get_asFloat('C_11')
-    lattice_C66(1,2,p) = elasticity%get_asFloat('C_12')
+    lattice_C66(1,2,ph) = elasticity%get_asFloat('C_12')
 
-    lattice_C66(1,3,p) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal)
+    lattice_C66(1,3,ph) = elasticity%get_asFloat('C_13',defaultVal=0.0_pReal)
-    lattice_C66(2,2,p) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal)
+    lattice_C66(2,2,ph) = elasticity%get_asFloat('C_22',defaultVal=0.0_pReal)
-    lattice_C66(2,3,p) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal)
+    lattice_C66(2,3,ph) = elasticity%get_asFloat('C_23',defaultVal=0.0_pReal)
-    lattice_C66(3,3,p) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal)
+    lattice_C66(3,3,ph) = elasticity%get_asFloat('C_33',defaultVal=0.0_pReal)
-    lattice_C66(4,4,p) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal)
+    lattice_C66(4,4,ph) = elasticity%get_asFloat('C_44',defaultVal=0.0_pReal)
-    lattice_C66(5,5,p) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal)
+    lattice_C66(5,5,ph) = elasticity%get_asFloat('C_55',defaultVal=0.0_pReal)
-    lattice_C66(6,6,p) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal)
+    lattice_C66(6,6,ph) = elasticity%get_asFloat('C_66',defaultVal=0.0_pReal)
 
     select case(phase%get_asString('lattice'))
       case('cF')
-        lattice_structure(p) = lattice_FCC_ID
+        lattice_structure(ph) = lattice_FCC_ID
       case('cI')
-        lattice_structure(p) = lattice_BCC_ID
+        lattice_structure(ph) = lattice_BCC_ID
       case('hP')
-        lattice_structure(p) = lattice_HEX_ID
+        lattice_structure(ph) = lattice_HEX_ID
       case('tI')
-        lattice_structure(p) = lattice_BCT_ID
+        lattice_structure(ph) = lattice_BCT_ID
       case('oP')
-        lattice_structure(p) = lattice_ORT_ID
+        lattice_structure(ph) = lattice_ORT_ID
       case('aP')
-        lattice_structure(p) = lattice_ISO_ID
+        lattice_structure(ph) = lattice_ISO_ID
       case default
         call IO_error(130,ext_msg='lattice_init: '//phase%get_asString('lattice'))
     end select
 
-    lattice_C66(1:6,1:6,p) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,p),phase%get_asString('lattice'))
+    lattice_C66(1:6,1:6,ph) = applyLatticeSymmetryC66(lattice_C66(1:6,1:6,ph),phase%get_asString('lattice'))
 
-    lattice_mu(p) = equivalent_mu(lattice_C66(1:6,1:6,p),'voigt')
+    lattice_nu(ph) = lattice_equivalent_nu(lattice_C66(1:6,1:6,ph),'voigt')
-    lattice_nu(p) = equivalent_nu(lattice_C66(1:6,1:6,p),'voigt')
+    lattice_mu(ph) = lattice_equivalent_mu(lattice_C66(1:6,1:6,ph),'voigt')
 
-    lattice_C66(1:6,1:6,p) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,p)))           ! Literature data is in Voigt notation
+    lattice_C66(1:6,1:6,ph) = math_sym3333to66(math_Voigt66to3333(lattice_C66(1:6,1:6,ph)))           ! Literature data is in Voigt notation
     do i = 1, 6
-      if (abs(lattice_C66(i,i,p))<tol_math_check) &
+      if (abs(lattice_C66(i,i,ph))<tol_math_check) &
-        call IO_error(135,el=i,ip=p,ext_msg='matrix diagonal "el"ement of phase "ip"')
+        call IO_error(135,el=i,ip=ph,ext_msg='matrix diagonal "el"ement of phase "ip"')
     enddo
 
+    lattice_rho(ph) = phase%get_asFloat('rho', defaultVal=0.0_pReal)
 
     ! SHOULD NOT BE PART OF LATTICE BEGIN
-    lattice_K(1,1,p) = phase%get_asFloat('K_11',defaultVal=0.0_pReal)
+
-    lattice_K(2,2,p) = phase%get_asFloat('K_22',defaultVal=0.0_pReal)
+    if (phase%contains('thermal')) then
-    lattice_K(3,3,p) = phase%get_asFloat('K_33',defaultVal=0.0_pReal)
+      thermal  => phase%get('thermal')
-    lattice_K(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_K(1:3,1:3,p), &
+      lattice_K(1,1,ph) = thermal%get_asFloat('K_11',defaultVal=0.0_pReal)
+      lattice_K(2,2,ph) = thermal%get_asFloat('K_22',defaultVal=0.0_pReal)
+      lattice_K(3,3,ph) = thermal%get_asFloat('K_33',defaultVal=0.0_pReal)
+      lattice_K(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_K(1:3,1:3,ph), &
+                                                             phase%get_asString('lattice'))
+      lattice_c_p(ph) = thermal%get_asFloat('c_p', defaultVal=0.0_pReal)
+    endif
+
+
+    lattice_D(1,1,ph) = phase%get_asFloat('D_11',defaultVal=0.0_pReal)
+    lattice_D(2,2,ph) = phase%get_asFloat('D_22',defaultVal=0.0_pReal)
+    lattice_D(3,3,ph) = phase%get_asFloat('D_33',defaultVal=0.0_pReal)
+    lattice_D(1:3,1:3,ph) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,ph), &
                                                           phase%get_asString('lattice'))
 
-    lattice_c_p(p) = phase%get_asFloat('c_p', defaultVal=0.0_pReal)
+    lattice_M(ph) = phase%get_asFloat('M',defaultVal=0.0_pReal)
-    lattice_rho(p) = phase%get_asFloat('rho', defaultVal=0.0_pReal)
-
-    lattice_D(1,1,p) = phase%get_asFloat('D_11',defaultVal=0.0_pReal)
-    lattice_D(2,2,p) = phase%get_asFloat('D_22',defaultVal=0.0_pReal)
-    lattice_D(3,3,p) = phase%get_asFloat('D_33',defaultVal=0.0_pReal)
-    lattice_D(1:3,1:3,p) = lattice_applyLatticeSymmetry33(lattice_D(1:3,1:3,p), &
-                                                          phase%get_asString('lattice'))
-
-    lattice_M(p) = phase%get_asFloat('M',defaultVal=0.0_pReal)
     ! SHOULD NOT BE PART OF LATTICE END
 
     call selfTest
@@ -2188,15 +2195,16 @@ end function getlabels
 !> @brief Equivalent Poisson's ratio (ν)
 !> @details https://doi.org/10.1143/JPSJ.20.635
 !--------------------------------------------------------------------------------------------------
-function equivalent_nu(C,assumption) result(nu)
+function lattice_equivalent_nu(C,assumption) result(nu)
 
   real(pReal), dimension(6,6), intent(in) :: C                                                      !< Stiffness tensor (Voigt notation)
   character(len=*),            intent(in) :: assumption                                             !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress)
-
   real(pReal)                 :: K, mu, nu
+
   logical                     :: error
   real(pReal), dimension(6,6) :: S
 
+
   if    (IO_lc(assumption) == 'voigt') then
     K = (C(1,1)+C(2,2)+C(3,3) +2.0_pReal*(C(1,2)+C(2,3)+C(1,3))) &
       / 9.0_pReal
@@ -2210,25 +2218,26 @@ function equivalent_nu(C,assumption) result(nu)
     K = 0.0_pReal
   endif
 
-  mu = equivalent_mu(C,assumption)
+  mu = lattice_equivalent_mu(C,assumption)
   nu = (1.5_pReal*K -mu)/(3.0_pReal*K+mu)
 
-end function equivalent_nu
+end function lattice_equivalent_nu
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief Equivalent shear modulus (μ)
 !> @details https://doi.org/10.1143/JPSJ.20.635
 !--------------------------------------------------------------------------------------------------
-function equivalent_mu(C,assumption) result(mu)
+function lattice_equivalent_mu(C,assumption) result(mu)
 
   real(pReal), dimension(6,6), intent(in) :: C                                                      !< Stiffness tensor (Voigt notation)
   character(len=*),            intent(in) :: assumption                                             !< Assumption ('Voigt' = isostrain, 'Reuss' = isostress)
-
   real(pReal)                 :: mu
+
   logical                     :: error
   real(pReal), dimension(6,6) :: S
 
+
   if    (IO_lc(assumption) == 'voigt') then
     mu = (1.0_pReal*(C(1,1)+C(2,2)+C(3,3)) -1.0_pReal*(C(1,2)+C(2,3)+C(1,3)) +3.0_pReal*(C(4,4)+C(5,5)+C(6,6))) &
        / 15.0_pReal
@@ -2242,7 +2251,7 @@ function equivalent_mu(C,assumption) result(mu)
     mu = 0.0_pReal
   endif
 
-end function equivalent_mu
+end function lattice_equivalent_mu
 
 
 !--------------------------------------------------------------------------------------------------
@@ -2266,14 +2275,14 @@ subroutine selfTest
   call random_number(C)
   C(1,1) = C(1,1) + 1.0_pReal
   C = applyLatticeSymmetryC66(C,'aP')
-  if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt'
+  if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt'
-  if(dNeq(C(6,6),equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss'
+  if(dNeq(C(6,6),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss'
 
   lambda = C(1,2)
-  if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'voigt')),equivalent_nu(C,'voigt'),1.0e-12_pReal)) &
+  if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'voigt')), &
-    error stop 'equivalent_nu/voigt'
+          lattice_equivalent_nu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_nu/voigt'
-  if(dNeq(lambda*0.5_pReal/(lambda+equivalent_mu(C,'reuss')),equivalent_nu(C,'reuss'),1.0e-12_pReal)) &
+  if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'reuss')), &
-    error stop 'equivalent_nu/reuss'
+          lattice_equivalent_nu(C,'reuss'),1.0e-12_pReal)) error stop 'equivalent_nu/reuss'
 
 end subroutine selfTest
 

src/marc/discretization_marc.f90

@@ -12,7 +12,6 @@ module discretization_marc
   use DAMASK_interface
   use IO
   use config
-  use FEsolving
   use element
   use discretization
   use geometry_plastic_nonlocal
@@ -89,9 +88,6 @@ subroutine discretization_marc_init
   if (debug_e < 1 .or. debug_e > nElems)    call IO_error(602,ext_msg='element')
   if (debug_i < 1 .or. debug_i > elem%nIPs) call IO_error(602,ext_msg='IP')
 
-  FEsolving_execElem = [1,nElems]
-  FEsolving_execIP   = [1,elem%nIPs]
-
   allocate(cellNodeDefinition(elem%nNodes-1))
   allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,nElems))
   call buildCells(connectivity_cell,cellNodeDefinition,&

src/material.f90

@@ -17,34 +17,9 @@ module material
   private
 
   enum, bind(c); enumerator :: &
-    ELASTICITY_UNDEFINED_ID, &
-    ELASTICITY_HOOKE_ID, &
-    PLASTICITY_UNDEFINED_ID, &
-    PLASTICITY_NONE_ID, &
-    PLASTICITY_ISOTROPIC_ID, &
-    PLASTICITY_PHENOPOWERLAW_ID, &
-    PLASTICITY_KINEHARDENING_ID, &
-    PLASTICITY_DISLOTWIN_ID, &
-    PLASTICITY_DISLOTUNGSTEN_ID, &
-    PLASTICITY_NONLOCAL_ID, &
-    SOURCE_UNDEFINED_ID ,&
-    SOURCE_THERMAL_DISSIPATION_ID, &
-    SOURCE_THERMAL_EXTERNALHEAT_ID, &
-    SOURCE_DAMAGE_ISOBRITTLE_ID, &
-    SOURCE_DAMAGE_ISODUCTILE_ID, &
-    SOURCE_DAMAGE_ANISOBRITTLE_ID, &
-    SOURCE_DAMAGE_ANISODUCTILE_ID, &
-    KINEMATICS_UNDEFINED_ID ,&
-    KINEMATICS_CLEAVAGE_OPENING_ID, &
-    KINEMATICS_SLIPPLANE_OPENING_ID, &
-    KINEMATICS_THERMAL_EXPANSION_ID, &
-    STIFFNESS_DEGRADATION_UNDEFINED_ID, &
-    STIFFNESS_DEGRADATION_DAMAGE_ID, &
     THERMAL_ISOTHERMAL_ID, &
-    THERMAL_ADIABATIC_ID, &
     THERMAL_CONDUCTION_ID, &
     DAMAGE_NONE_ID, &
-    DAMAGE_LOCAL_ID, &
     DAMAGE_NONLOCAL_ID, &
     HOMOGENIZATION_UNDEFINED_ID, &
     HOMOGENIZATION_NONE_ID, &
@@ -64,21 +39,20 @@ module material
     homogenization_type                                                                             !< type of each homogenization
 
   integer, public, protected :: &
-    homogenization_maxNconstituents                                                                  !< max number of grains in any USED homogenization
+    homogenization_maxNconstituents                                                                 !< max number of grains in any USED homogenization
 
   integer, dimension(:), allocatable, public, protected :: &
-    homogenization_Nconstituents, &                                                                  !< number of grains in each homogenization
+    homogenization_Nconstituents, &                                                                 !< number of grains in each homogenization
     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
 
   real(pReal), dimension(:), allocatable, public, protected :: &
-    thermal_initialT, &                                                                             !< initial temperature per each homogenization
+    thermal_initialT                                                                                !< initial temperature per each homogenization
-    damage_initialPhi                                                                               !< initial damage per each homogenization
 
   integer, dimension(:),     allocatable, public, protected :: &                                    ! (elem)
     material_homogenizationAt                                                                       !< homogenization ID of each element
-  integer, dimension(:,:),   allocatable, public, target :: &                                       ! (ip,elem) ToDo: ugly target for mapping hack
+  integer, dimension(:,:),   allocatable, public, protected :: &                                    ! (ip,elem)
     material_homogenizationMemberAt                                                                 !< position of the element within its homogenization instance
   integer, dimension(:,:),   allocatable, public, protected :: &                                    ! (constituent,elem)
     material_phaseAt                                                                                !< phase ID of each element
@@ -87,20 +61,11 @@ module material
 
   type(tState),        allocatable, dimension(:), public :: &
     homogState, &
-    thermalState, &
+    damageState_h
-    damageState
 
   type(Rotation), dimension(:,:,:), allocatable, public, protected :: &
     material_orientation0                                                                           !< initial orientation of each grain,IP,element
 
-! BEGIN DEPRECATED
-  integer, dimension(:,:),   allocatable, private, target :: mappingHomogenizationConst             !< mapping from material points to offset in constant state/field
-! END DEPRECATED
-
-  type(tHomogMapping), allocatable, dimension(:), public :: &
-    thermalMapping, &                                                                               !< mapping for thermal state/fields
-    damageMapping                                                                                   !< mapping for damage state/fields
-
   type(group_float),  allocatable, dimension(:), public :: &
     temperature, &                                                                                  !< temperature field
     damage, &                                                                                       !< damage field
@@ -108,34 +73,9 @@ module material
 
   public :: &
     material_init, &
-    ELASTICITY_UNDEFINED_ID, &
-    ELASTICITY_HOOKE_ID, &
-    PLASTICITY_UNDEFINED_ID, &
-    PLASTICITY_NONE_ID, &
-    PLASTICITY_ISOTROPIC_ID, &
-    PLASTICITY_PHENOPOWERLAW_ID, &
-    PLASTICITY_KINEHARDENING_ID, &
-    PLASTICITY_DISLOTWIN_ID, &
-    PLASTICITY_DISLOTUNGSTEN_ID, &
-    PLASTICITY_NONLOCAL_ID, &
-    SOURCE_UNDEFINED_ID ,&
-    SOURCE_THERMAL_DISSIPATION_ID, &
-    SOURCE_THERMAL_EXTERNALHEAT_ID, &
-    SOURCE_DAMAGE_ISOBRITTLE_ID, &
-    SOURCE_DAMAGE_ISODUCTILE_ID, &
-    SOURCE_DAMAGE_ANISOBRITTLE_ID, &
-    SOURCE_DAMAGE_ANISODUCTILE_ID, &
-    KINEMATICS_UNDEFINED_ID ,&
-    KINEMATICS_CLEAVAGE_OPENING_ID, &
-    KINEMATICS_SLIPPLANE_OPENING_ID, &
-    KINEMATICS_THERMAL_EXPANSION_ID, &
-    STIFFNESS_DEGRADATION_UNDEFINED_ID, &
-    STIFFNESS_DEGRADATION_DAMAGE_ID, &
     THERMAL_ISOTHERMAL_ID, &
-    THERMAL_ADIABATIC_ID, &
     THERMAL_CONDUCTION_ID, &
     DAMAGE_NONE_ID, &
-    DAMAGE_LOCAL_ID, &
     DAMAGE_NONLOCAL_ID, &
     HOMOGENIZATION_NONE_ID, &
     HOMOGENIZATION_ISOSTRAIN_ID, &
@@ -149,7 +89,6 @@ contains
 subroutine material_init(restart)
 
   logical, intent(in) :: restart
-  integer             :: myHomog
 
   print'(/,a)', ' <<<+-  material init  -+>>>'; flush(IO_STDOUT)
 
@@ -162,39 +101,20 @@ subroutine material_init(restart)
 
 
   allocate(homogState      (size(material_name_homogenization)))
-  allocate(thermalState    (size(material_name_homogenization)))
+  allocate(damageState_h     (size(material_name_homogenization)))
-  allocate(damageState     (size(material_name_homogenization)))
-
-  allocate(thermalMapping  (size(material_name_homogenization)))
-  allocate(damageMapping   (size(material_name_homogenization)))
 
   allocate(temperature     (size(material_name_homogenization)))
   allocate(damage          (size(material_name_homogenization)))
-
   allocate(temperatureRate (size(material_name_homogenization)))
 
 
   if (.not. restart) then
     call results_openJobFile
-    call results_mapping_constituent(material_phaseAt,material_phaseMemberAt,material_name_phase)
+    call results_mapping_phase(material_phaseAt,material_phaseMemberAt,material_name_phase)
     call results_mapping_homogenization(material_homogenizationAt,material_homogenizationMemberAt,material_name_homogenization)
     call results_closeJobFile
   endif
 
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! BEGIN DEPRECATED
-  allocate(mappingHomogenizationConst(  discretization_nIPs,discretization_Nelems),source=1)
-
-! hack needed to initialize field values used during constitutive initialization
-  do myHomog = 1, size(material_name_homogenization)
-    thermalMapping     (myHomog)%p => mappingHomogenizationConst
-    damageMapping      (myHomog)%p => mappingHomogenizationConst
-    allocate(temperature     (myHomog)%p(1), source=thermal_initialT(myHomog))
-    allocate(damage          (myHomog)%p(1), source=damage_initialPhi(myHomog))
-    allocate(temperatureRate (myHomog)%p(1), source=0.0_pReal)
-  enddo
-! END DEPRECATED
-
 end subroutine material_init
 
 
@@ -222,7 +142,6 @@ subroutine material_parseHomogenization
   allocate(thermal_typeInstance(size(material_name_homogenization)),          source=0)
   allocate(damage_typeInstance(size(material_name_homogenization)),           source=0)
   allocate(thermal_initialT(size(material_name_homogenization)),              source=300.0_pReal)
-  allocate(damage_initialPhi(size(material_name_homogenization)),             source=1.0_pReal)
 
   do h=1, size(material_name_homogenization)
     homog => material_homogenization%get(h)
@@ -247,8 +166,6 @@ subroutine material_parseHomogenization
         select case (homogThermal%get_asString('type'))
           case('isothermal')
             thermal_type(h) = THERMAL_isothermal_ID
-          case('adiabatic')
-            thermal_type(h) = THERMAL_adiabatic_ID
           case('conduction')
             thermal_type(h) = THERMAL_conduction_ID
           case default
@@ -258,12 +175,9 @@ subroutine material_parseHomogenization
 
     if(homog%contains('damage')) then
       homogDamage => homog%get('damage')
-        damage_initialPhi(h) =  homogDamage%get_asFloat('phi_0',defaultVal=1.0_pReal)
         select case (homogDamage%get_asString('type'))
           case('none')
             damage_type(h) = DAMAGE_none_ID
-          case('local')
-            damage_type(h) = DAMAGE_local_ID
           case('nonlocal')
             damage_type(h) = DAMAGE_nonlocal_ID
           case default

src/math.f90

@@ -279,9 +279,12 @@ real(pReal) pure function math_LeviCivita(i,j,k)
 
   integer, intent(in) :: i,j,k
 
-  if     (all([i,j,k] == [1,2,3]) .or. all([i,j,k] == [2,3,1]) .or. all([i,j,k] == [3,1,2])) then
+  integer :: o
+
+
+  if     (any([(all(cshift([i,j,k],o) == [1,2,3]),o=0,2)])) then
     math_LeviCivita = +1.0_pReal
-  elseif (all([i,j,k] == [3,2,1]) .or. all([i,j,k] == [2,1,3]) .or. all([i,j,k] == [1,3,2])) then
+  elseif (any([(all(cshift([i,j,k],o) == [3,2,1]),o=0,2)])) then
     math_LeviCivita = -1.0_pReal
   else
     math_LeviCivita =  0.0_pReal

src/mesh/DAMASK_mesh.f90

@@ -15,7 +15,6 @@ program DAMASK_mesh
   use IO
   use math
   use CPFEM2
-  use FEsolving
   use config
   use discretization_mesh
   use FEM_Utilities

src/mesh/FEM_utilities.f90

@@ -160,11 +160,11 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
 
   print'(/,a)', ' ... evaluating constitutive response ......................................'
 
-  call materialpoint_stressAndItsTangent(timeinc)                                                   ! calculate P field
+  call materialpoint_stressAndItsTangent(timeinc,[1,mesh_maxNips],[1,mesh_NcpElems])                ! calculate P field
 
   cutBack = .false.                                                                                 ! reset cutBack status
   
-  P_av = sum(sum(homogenization_P,dim=4),dim=3) * wgt                                                ! average of P 
+  P_av = sum(homogenization_P,dim=3) * wgt
   call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr)
 
 end subroutine utilities_constitutiveResponse

src/mesh/discretization_mesh.f90

@@ -18,7 +18,6 @@ module discretization_mesh
   use config
   use discretization
   use results
-  use FEsolving
   use FEM_quadrature
   use YAML_types
   use prec
@@ -30,7 +29,7 @@ module discretization_mesh
     mesh_Nboundaries, &
     mesh_NcpElemsGlobal
 
-  integer :: &
+  integer, public, protected :: &
     mesh_NcpElems                                                                                   !< total number of CP elements in mesh
 
 !!!! BEGIN DEPRECATED !!!!!
@@ -84,6 +83,7 @@ subroutine discretization_mesh_init(restart)
     num_mesh
   integer :: integrationOrder                                                                       !< order of quadrature rule required
 
+
   print'(/,a)',   ' <<<+-  discretization_mesh init  -+>>>'
 
 !--------------------------------------------------------------------------------
@@ -96,13 +96,15 @@ subroutine discretization_mesh_init(restart)
   debug_element = config_debug%get_asInt('element',defaultVal=1)
   debug_ip      = config_debug%get_asInt('integrationpoint',defaultVal=1)
 
-
   call DMPlexCreateFromFile(PETSC_COMM_WORLD,interface_geomFile,PETSC_TRUE,globalMesh,ierr)
   CHKERRQ(ierr)
   call DMGetDimension(globalMesh,dimPlex,ierr)
   CHKERRQ(ierr)
   call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr)
   CHKERRQ(ierr)
+  call DMView(globalMesh, PETSC_VIEWER_STDOUT_WORLD,ierr)
+  CHKERRQ(ierr)
+
   ! get number of IDs in face sets (for boundary conditions?)
   call DMGetLabelSize(globalMesh,'Face Sets',mesh_Nboundaries,ierr)
   CHKERRQ(ierr)
@@ -110,6 +112,13 @@ subroutine discretization_mesh_init(restart)
   call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
   call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
 
+  if (worldrank == 0) then
+    call DMClone(globalMesh,geomMesh,ierr)
+  else
+    call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr)
+  endif
+  CHKERRQ(ierr)
+
   allocate(mesh_boundaries(mesh_Nboundaries), source = 0)
   call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr)
   CHKERRQ(ierr)
@@ -124,35 +133,6 @@ subroutine discretization_mesh_init(restart)
   endif
   call MPI_Bcast(mesh_boundaries,mesh_Nboundaries,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr)
 
-  if (worldrank == 0) then
-    fileContent = IO_readlines(interface_geomFile)
-    l = 0
-    do
-      l = l + 1
-      if (IO_isBlank(fileContent(l))) cycle         ! need also to ignore C and C++ style comments?
-      if (trim(fileContent(l)) == '$Elements') then
-        j = 0
-        l = l + 1
-        do
-          l = l + 1
-          if (trim(fileContent(l)) == '$EndElements') exit
-          chunkPos = IO_stringPos(fileContent(l))
-          if (chunkPos(1) == 3+IO_intValue(fileContent(l),chunkPos,3)+dimPlex+1) then
-            call DMSetLabelValue(globalMesh,'material',j,IO_intValue(fileContent(l),chunkPos,4),ierr)
-            CHKERRQ(ierr)
-            j = j + 1
-          endif
-        enddo
-        exit
-      endif
-    enddo
-    call DMClone(globalMesh,geomMesh,ierr)
-    CHKERRQ(ierr)
-  else
-    call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr)
-    CHKERRQ(ierr)
-  endif
-
   call DMDestroy(globalMesh,ierr); CHKERRQ(ierr)
 
   call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_NcpElems,ierr)
@@ -167,16 +147,14 @@ subroutine discretization_mesh_init(restart)
 
   allocate(materialAt(mesh_NcpElems))
   do j = 1, mesh_NcpElems
-    call DMGetLabelValue(geomMesh,'material',j-1,materialAt(j),ierr)
+    call DMGetLabelValue(geomMesh,'Cell Sets',j-1,materialAt(j),ierr)
     CHKERRQ(ierr)
   end do
+  materialAt = materialAt + 1
 
   if (debug_element < 1 .or. debug_element > mesh_NcpElems) call IO_error(602,ext_msg='element')
   if (debug_ip < 1 .or. debug_ip > mesh_maxNips)            call IO_error(602,ext_msg='IP')
 
-  FEsolving_execElem = [1,mesh_NcpElems]                                                            ! parallel loop bounds set to comprise all DAMASK elements
-  FEsolving_execIP   = [1,mesh_maxNips]
-
   allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal)
 
   call discretization_init(materialAt,&

src/mesh/mesh_mech_FEM.f90

@@ -32,7 +32,6 @@ module mesh_mech_FEM
   type tSolutionParams
     type(tFieldBC)  :: fieldBC
     real(pReal)     :: timeinc
-    real(pReal)     :: timeincOld
   end type tSolutionParams
 
   type(tSolutionParams)  :: params
@@ -147,14 +146,9 @@ subroutine FEM_mech_init(fieldBC)
   call PetscFESetQuadrature(mechFE,mechQuad,ierr); CHKERRQ(ierr)
   call PetscFEGetDimension(mechFE,nBasis,ierr); CHKERRQ(ierr)
   nBasis = nBasis/nc
-#if (PETSC_VERSION_MINOR > 10)
   call DMAddField(mech_mesh,PETSC_NULL_DMLABEL,mechFE,ierr); CHKERRQ(ierr)
   call DMCreateDS(mech_mesh,ierr); CHKERRQ(ierr)
-#endif
   call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr)
-#if (PETSC_VERSION_MINOR < 11)
-  call PetscDSAddDiscretization(mechDS,mechFE,ierr); CHKERRQ(ierr)
-#endif
   call PetscDSGetTotalDimension(mechDS,cellDof,ierr); CHKERRQ(ierr)
   call PetscFEDestroy(mechFE,ierr); CHKERRQ(ierr)
   call PetscQuadratureDestroy(mechQuad,ierr); CHKERRQ(ierr)
@@ -163,11 +157,7 @@ subroutine FEM_mech_init(fieldBC)
 ! Setup FEM mech boundary conditions
   call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr)
   call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr)
-#if (PETSC_VERSION_MINOR < 12)
-  call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr)
-#else
   call DMGetLocalSection(mech_mesh,section,ierr); CHKERRQ(ierr)
-#endif
   allocate(pnumComp(1), source=dimPlex)
   allocate(pnumDof(0:dimPlex), source = 0)
   do topologDim = 0, dimPlex
@@ -205,14 +195,8 @@ subroutine FEM_mech_init(fieldBC)
       endif
     endif
   enddo; enddo
-#if (PETSC_VERSION_MINOR < 11)
-  call DMPlexCreateSection(mech_mesh,dimPlex,1,pNumComp,pNumDof, &
-                           numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS,section,ierr)
-#else
   call DMPlexCreateSection(mech_mesh,nolabel,pNumComp,pNumDof, &
                            numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS,section,ierr)
-
-#endif
   CHKERRQ(ierr)
   call DMSetSection(mech_mesh,section,ierr); CHKERRQ(ierr)
   do faceSet = 1, numBC
@@ -267,11 +251,7 @@ subroutine FEM_mech_init(fieldBC)
       x_scal(basis+1:basis+dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0_pReal)
     enddo
     px_scal => x_scal
-#if (PETSC_VERSION_MINOR < 11)
+    call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,5,ierr)
-    call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,INSERT_ALL_VALUES,ierr)
-#else
-    call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,5,ierr)                  ! PETSc: cbee0a90b60958e5c50c89b1e41f4451dfa6008c
-#endif
     CHKERRQ(ierr)
   enddo
 
@@ -302,7 +282,6 @@ type(tSolutionState) function FEM_mech_solution( &
 !--------------------------------------------------------------------------------------------------
 ! set module wide availabe data
   params%timeinc = timeinc
-  params%timeincOld = timeinc_old
   params%fieldBC = fieldBC
 
   call SNESSolve(mech_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr)                             ! solve mech_snes based on solution guess (result in solution)
@@ -337,16 +316,16 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
   Vec                                :: x_local, f_local, xx_local
   PetscSection                       :: section
   PetscScalar, dimension(:), pointer :: x_scal, pf_scal
-  PetscScalar,                target :: f_scal(cellDof)
+  PetscScalar, dimension(cellDof), target :: f_scal
-  PetscReal                          :: detJ, IcellJMat(dimPlex,dimPlex)
+  PetscReal                          ::  IcellJMat(dimPlex,dimPlex)
-  PetscReal,  pointer,dimension(:)   :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer
+  PetscReal,    dimension(:),pointer :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer
   PetscInt                           :: cellStart, cellEnd, cell, field, face, &
                                         qPt, basis, comp, cidx, &
-                                        numFields
+                                        numFields, &
-  PetscReal                          :: detFAvg
+                                        bcSize,m
-  PetscReal                          :: BMat(dimPlex*dimPlex,cellDof)
+  PetscReal                          :: detFAvg, detJ
+  PetscReal, dimension(dimPlex*dimPlex,cellDof) :: BMat
 
-  PetscInt                           :: bcSize
   IS                                 :: bcPoints
 
 
@@ -355,11 +334,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
   allocate(pinvcellJ(dimPlex**2))
   allocate(x_scal(cellDof))
 
-#if (PETSC_VERSION_MINOR < 12)
-  call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr)
-#else
   call DMGetLocalSection(dm_local,section,ierr); CHKERRQ(ierr)
-#endif
   call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr)
   call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr)
   CHKERRQ(ierr)
@@ -391,6 +366,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
     CHKERRQ(ierr)
     IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
     do qPt = 0, nQuadrature-1
+      m = cell*nQuadrature + qPt+1
       BMat = 0.0
       do basis = 0, nBasis-1
         do comp = 0, dimPlex-1
@@ -400,15 +376,14 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
                                            (((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex))
         enddo
       enddo
-      homogenization_F(1:dimPlex,1:dimPlex,qPt+1,cell+1) = &
+      homogenization_F(1:dimPlex,1:dimPlex,m) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1])
-        reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1])
     enddo
     if (num%BBarStabilisation) then
-      detFAvg = math_det33(sum(homogenization_F(1:3,1:3,1:nQuadrature,cell+1),dim=3)/real(nQuadrature))
+      detFAvg = math_det33(sum(homogenization_F(1:3,1:3,cell*nQuadrature+1:(cell+1)*nQuadrature),dim=3)/real(nQuadrature))
-      do qPt = 1, nQuadrature
+      do qPt = 0, nQuadrature-1
-        homogenization_F(1:dimPlex,1:dimPlex,qPt,cell+1) = &
+        m = cell*nQuadrature + qPt+1
-          homogenization_F(1:dimPlex,1:dimPlex,qPt,cell+1)* &
+        homogenization_F(1:dimPlex,1:dimPlex,m) = homogenization_F(1:dimPlex,1:dimPlex,m) &
-          (detFAvg/math_det33(homogenization_F(1:3,1:3,qPt,cell+1)))**(1.0/real(dimPlex))
+                                                * (detFAvg/math_det33(homogenization_F(1:3,1:3,m)))**(1.0/real(dimPlex))
 
       enddo
     endif
@@ -432,6 +407,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
     IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex])
     f_scal = 0.0
     do qPt = 0, nQuadrature-1
+      m = cell*nQuadrature + qPt+1
       BMat = 0.0
       do basis = 0, nBasis-1
         do comp = 0, dimPlex-1
@@ -443,7 +419,7 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
       enddo
       f_scal = f_scal + &
                matmul(transpose(BMat), &
-                      reshape(transpose(homogenization_P(1:dimPlex,1:dimPlex,qPt+1,cell+1)), &
+                      reshape(transpose(homogenization_P(1:dimPlex,1:dimPlex,m)), &
                               shape=[dimPlex*dimPlex]))*qWeights(qPt+1)
     enddo
     f_scal = f_scal*abs(detJ)
@@ -488,7 +464,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
                                           K_eB
 
   PetscInt                             :: cellStart, cellEnd, cell, field, face, &
-                                          qPt, basis, comp, cidx,bcSize
+                                          qPt, basis, comp, cidx,bcSize, m
 
   IS                                   :: bcPoints
 
@@ -502,11 +478,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
   call MatZeroEntries(Jac,ierr); CHKERRQ(ierr)
   call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr)
   call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr)
-#if (PETSC_VERSION_MINOR < 12)
-  call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr)
-#else
   call DMGetLocalSection(dm_local,section,ierr); CHKERRQ(ierr)
-#endif
   call DMGetGlobalSection(dm_local,gSection,ierr); CHKERRQ(ierr)
 
   call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
@@ -535,6 +507,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
     FAvg = 0.0
     BMatAvg = 0.0
     do qPt = 0, nQuadrature-1
+      m = cell*nQuadrature + qPt + 1
       BMat = 0.0
       do basis = 0, nBasis-1
         do comp = 0, dimPlex-1
@@ -545,7 +518,7 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
                                            (((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex))
         enddo
       enddo
-      MatA = matmul(reshape(reshape(homogenization_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,qPt+1,cell+1), &
+      MatA = matmul(reshape(reshape(homogenization_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,m), &
                                     shape=[dimPlex,dimPlex,dimPlex,dimPlex], order=[2,1,4,3]), &
                             shape=[dimPlex*dimPlex,dimPlex*dimPlex]),BMat)*qWeights(qPt+1)
       if (num%BBarStabilisation) then
@@ -553,12 +526,11 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
         FInv = math_inv33(F)
         K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0/real(dimPlex))
         K_eB = K_eB - &
-               matmul(transpose(matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,qPt+1,cell+1), &
+               matmul(transpose(matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,m),shape=[dimPlex*dimPlex,1]), &
-                                               shape=[dimPlex*dimPlex,1]), &
                                        matmul(reshape(FInv(1:dimPlex,1:dimPlex), &
                                                       shape=[1,dimPlex*dimPlex],order=[2,1]),BMat))),MatA)
-        MatB = MatB + &
+        MatB = MatB &
-               matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,qPt+1,cell+1),shape=[1,dimPlex*dimPlex]),MatA)
+             + matmul(reshape(homogenization_F(1:dimPlex,1:dimPlex,m),shape=[1,dimPlex*dimPlex]),MatA)
         FAvg = FAvg + F
         BMatAvg = BMatAvg + BMat
       else
@@ -686,8 +658,8 @@ subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dumm
   print'(/,1x,a,a,i0,a,i0,f0.3)', trim(incInfo), &
                   ' @ Iteration ',PETScIter,' mechanical residual norm = ', &
                                                   int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol)
-  write(IO_STDOUT,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',&
+  print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
-                                                        transpose(P_av)*1.e-6_pReal
+    ' Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal
   flush(IO_STDOUT)
 
 end subroutine FEM_mech_converged

src/prec.f90

@@ -54,7 +54,7 @@ module prec
   type, extends(tState) :: tPlasticState
     logical :: &
       nonlocal = .false.
-    real(pReal), pointer,     dimension(:,:) :: &
+    real(pReal), pointer, dimension(:,:) :: &
       slipRate                                                                                      !< slip rate
   end type
 
@@ -62,10 +62,6 @@ module prec
     type(tState), dimension(:), allocatable :: p                                                    !< tState for each active source mechanism in a phase
   end type
 
-  type :: tHomogMapping
-    integer, pointer, dimension(:,:) :: p
-  end type
-
   real(pReal), private, parameter :: PREAL_EPSILON = epsilon(0.0_pReal)                             !< minimum positive number such that 1.0 + EPSILON /= 1.0.
   real(pReal), private, parameter :: PREAL_MIN     = tiny(0.0_pReal)                                !< smallest normalized floating point number
 
@@ -112,8 +108,10 @@ logical elemental pure function dEq(a,b,tol)
 
   real(pReal), intent(in)           :: a,b
   real(pReal), intent(in), optional :: tol
+
   real(pReal)                       :: eps
 
+
   if (present(tol)) then
     eps = tol
   else
@@ -136,11 +134,8 @@ logical elemental pure function dNeq(a,b,tol)
   real(pReal), intent(in)           :: a,b
   real(pReal), intent(in), optional :: tol
 
-  if (present(tol)) then
+
-    dNeq = .not. dEq(a,b,tol)
+  dNeq = .not. dEq(a,b,tol)
-  else
-    dNeq = .not. dEq(a,b)
-  endif
 
 end function dNeq
 
@@ -155,8 +150,10 @@ logical elemental pure function dEq0(a,tol)
 
   real(pReal), intent(in)           :: a
   real(pReal), intent(in), optional :: tol
+
   real(pReal)                       :: eps
 
+
   if (present(tol)) then
     eps = tol
   else
@@ -179,11 +176,8 @@ logical elemental pure function dNeq0(a,tol)
   real(pReal), intent(in)           :: a
   real(pReal), intent(in), optional :: tol
 
-  if (present(tol)) then
+
-    dNeq0 = .not. dEq0(a,tol)
+  dNeq0 = .not. dEq0(a,tol)
-  else
-    dNeq0 = .not. dEq0(a)
-  endif
 
 end function dNeq0
 
@@ -199,8 +193,10 @@ logical elemental pure function cEq(a,b,tol)
 
   complex(pReal), intent(in)           :: a,b
   real(pReal),    intent(in), optional :: tol
+
   real(pReal)                          :: eps
 
+
   if (present(tol)) then
     eps = tol
   else
@@ -224,11 +220,8 @@ logical elemental pure function cNeq(a,b,tol)
   complex(pReal), intent(in)           :: a,b
   real(pReal),    intent(in), optional :: tol
 
-  if (present(tol)) then
+
-    cNeq = .not. cEq(a,b,tol)
+  cNeq = .not. cEq(a,b,tol)
-  else
-    cNeq = .not. cEq(a,b)
-  endif
 
 end function cNeq
 
@@ -242,6 +235,7 @@ pure function prec_bytesToC_FLOAT(bytes)
   real(C_FLOAT), dimension(size(bytes,kind=pI64)/(storage_size(0._C_FLOAT,pI64)/8_pI64)) :: &
     prec_bytesToC_FLOAT
 
+
   prec_bytesToC_FLOAT = transfer(bytes,prec_bytesToC_FLOAT,size(prec_bytesToC_FLOAT))
 
 end function prec_bytesToC_FLOAT
@@ -256,6 +250,7 @@ pure function prec_bytesToC_DOUBLE(bytes)
   real(C_DOUBLE), dimension(size(bytes,kind=pI64)/(storage_size(0._C_DOUBLE,pI64)/8_pI64)) :: &
     prec_bytesToC_DOUBLE
 
+
   prec_bytesToC_DOUBLE = transfer(bytes,prec_bytesToC_DOUBLE,size(prec_bytesToC_DOUBLE))
 
 end function prec_bytesToC_DOUBLE
@@ -270,6 +265,7 @@ pure function prec_bytesToC_INT32_T(bytes)
   integer(C_INT32_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT32_T,pI64)/8_pI64)) :: &
     prec_bytesToC_INT32_T
 
+
   prec_bytesToC_INT32_T = transfer(bytes,prec_bytesToC_INT32_T,size(prec_bytesToC_INT32_T))
 
 end function prec_bytesToC_INT32_T
@@ -284,6 +280,7 @@ pure function prec_bytesToC_INT64_T(bytes)
   integer(C_INT64_T), dimension(size(bytes,kind=pI64)/(storage_size(0_C_INT64_T,pI64)/8_pI64)) :: &
      prec_bytesToC_INT64_T
 
+
   prec_bytesToC_INT64_T = transfer(bytes,prec_bytesToC_INT64_T,size(prec_bytesToC_INT64_T))
 
 end function prec_bytesToC_INT64_T
@@ -299,6 +296,7 @@ subroutine selfTest
   integer(pInt), dimension(1) :: i
   real(pReal),   dimension(2) :: r
 
+
   realloc_lhs_test = [1,2]
   if (any(realloc_lhs_test/=[1,2]))        error stop 'LHS allocation'
 

src/quaternions.f90

@@ -1,534 +0,0 @@
-!---------------------------------------------------------------------------------------------------
-!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
-!> @author Philip Eisenlohr, Michigan State University
-!> @brief general quaternion math, not limited to unit quaternions
-!> @details w is the real part, (x, y, z) are the imaginary parts.
-!> @details https://en.wikipedia.org/wiki/Quaternion
-!---------------------------------------------------------------------------------------------------
-module quaternions
-  use prec
-
-  implicit none
-  private
-
-  real(pReal), parameter, public :: P = -1.0_pReal                                                  !< parameter for orientation conversion.
-
-  type, public :: quaternion
-    real(pReal), private :: w = 0.0_pReal
-    real(pReal), private :: x = 0.0_pReal
-    real(pReal), private :: y = 0.0_pReal
-    real(pReal), private :: z = 0.0_pReal
-
-
-  contains
-    procedure, private :: add__
-    procedure, private :: pos__
-    generic,   public  :: operator(+) => add__,pos__
-
-    procedure, private :: sub__
-    procedure, private :: neg__
-    generic,   public  :: operator(-) => sub__,neg__
-
-    procedure, private :: mul_quat__
-    procedure, private :: mul_scal__
-    generic,   public  :: operator(*) => mul_quat__, mul_scal__
-
-    procedure, private :: div_quat__
-    procedure, private :: div_scal__
-    generic,   public  :: operator(/) => div_quat__, div_scal__
-
-    procedure, private :: eq__
-    generic,   public  :: operator(==) => eq__
-
-    procedure, private :: neq__
-    generic,   public  :: operator(/=) => neq__
-
-    procedure, private :: pow_quat__
-    procedure, private :: pow_scal__
-    generic,   public  :: operator(**) => pow_quat__, pow_scal__
-
-    procedure, public  :: abs   => abs__
-    procedure, public  :: conjg => conjg__
-    procedure, public  :: real  => real__
-    procedure, public  :: aimag => aimag__
-
-    procedure, public  :: homomorphed
-    procedure, public  :: asArray
-    procedure, public  :: inverse
-
-  end type
-
-  interface assignment (=)
-    module procedure assign_quat__
-    module procedure assign_vec__
-  end interface assignment (=)
-
-  interface quaternion
-    module procedure init__
-  end interface quaternion
-
-  interface abs
-    procedure abs__
-  end interface abs
-
-  interface dot_product
-    procedure dot_product__
-  end interface dot_product
-
-  interface conjg
-    module procedure conjg__
-  end interface conjg
-
-  interface exp
-    module procedure exp__
-  end interface exp
-
-  interface log
-    module procedure log__
-  end interface log
-
-  interface real
-    module procedure real__
-  end interface real
-
-  interface aimag
-    module procedure aimag__
-  end interface aimag
-
-  public :: &
-    quaternions_init, &
-    assignment(=), &
-    conjg, aimag, &
-    log, exp, &
-    abs, dot_product, &
-    inverse, &
-    real
-
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief Do self test.
-!--------------------------------------------------------------------------------------------------
-subroutine quaternions_init
-
-  print'(/,a)', ' <<<+-  quaternions init  -+>>>'; flush(6)
-
-  call selfTest
-
-end subroutine quaternions_init
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief construct a quaternion from a 4-vector
-!---------------------------------------------------------------------------------------------------
-type(quaternion) pure function init__(array)
-
-  real(pReal), intent(in), dimension(4) :: array
-
-  init__%w = array(1)
-  init__%x = array(2)
-  init__%y = array(3)
-  init__%z = array(4)
-
-end function init__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief assign a quaternion
-!---------------------------------------------------------------------------------------------------
-elemental pure subroutine assign_quat__(self,other)
-
-  type(quaternion), intent(out) :: self
-  type(quaternion), intent(in)  :: other
-
-  self = [other%w,other%x,other%y,other%z]
-
-end subroutine assign_quat__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief assign a 4-vector
-!---------------------------------------------------------------------------------------------------
-pure subroutine assign_vec__(self,other)
-
-  type(quaternion), intent(out)                :: self
-  real(pReal),       intent(in), dimension(4)  :: other
-
-  self%w = other(1)
-  self%x = other(2)
-  self%y = other(3)
-  self%z = other(4)
-
-end subroutine assign_vec__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief add a quaternion
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function add__(self,other)
-
-  class(quaternion), intent(in) :: self,other
-
-  add__ = [ self%w,  self%x,  self%y ,self%z] &
-        + [other%w, other%x, other%y,other%z]
-
-end function add__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief return (unary positive operator)
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function pos__(self)
-
-  class(quaternion), intent(in) :: self
-
-  pos__ = self * (+1.0_pReal)
-
-end function pos__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief subtract a quaternion
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function sub__(self,other)
-
-  class(quaternion), intent(in) :: self,other
-
-  sub__ = [ self%w,  self%x,  self%y ,self%z] &
-        - [other%w, other%x, other%y,other%z]
-
-end function sub__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief negate (unary negative operator)
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function neg__(self)
-
-  class(quaternion), intent(in) :: self
-
-  neg__ = self * (-1.0_pReal)
-
-end function neg__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief multiply with a quaternion
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function mul_quat__(self,other)
-
-  class(quaternion), intent(in) :: self, other
-
-  mul_quat__%w = self%w*other%w - self%x*other%x -      self%y*other%y - self%z*other%z
-  mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y)
-  mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z)
-  mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x)
-
-end function mul_quat__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief multiply with a scalar
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function mul_scal__(self,scal)
-
-  class(quaternion), intent(in) :: self
-  real(pReal),       intent(in) :: scal
-
-  mul_scal__ = [self%w,self%x,self%y,self%z]*scal
-
-end function mul_scal__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief divide by a quaternion
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function div_quat__(self,other)
-
-  class(quaternion), intent(in) :: self, other
-
-  div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal))
-
-end function div_quat__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief divide by a scalar
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function div_scal__(self,scal)
-
-  class(quaternion), intent(in) :: self
-  real(pReal),       intent(in) :: scal
-
-  div_scal__ = [self%w,self%x,self%y,self%z]/scal
-
-end function div_scal__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief test equality
-!---------------------------------------------------------------------------------------------------
-logical elemental pure function eq__(self,other)
-
-  class(quaternion), intent(in) :: self,other
-
-  eq__ = all(dEq([ self%w, self%x, self%y, self%z], &
-                 [other%w,other%x,other%y,other%z]))
-
-end function eq__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief test inequality
-!---------------------------------------------------------------------------------------------------
-logical elemental pure function neq__(self,other)
-
-  class(quaternion), intent(in) :: self,other
-
-  neq__ = .not. self%eq__(other)
-
-end function neq__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief raise to the power of a quaternion
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function pow_quat__(self,expon)
-
-  class(quaternion), intent(in) :: self
-  type(quaternion),  intent(in) :: expon
-
-  pow_quat__ = exp(log(self)*expon)
-
-end function pow_quat__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief raise to the power of a scalar
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function pow_scal__(self,expon)
-
-  class(quaternion), intent(in) :: self
-  real(pReal),       intent(in) :: expon
-
-  pow_scal__ = exp(log(self)*expon)
-
-end function pow_scal__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief take exponential
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function exp__(a)
-
-  class(quaternion), intent(in) :: a
-  real(pReal)                   :: absImag
-
-  absImag = norm2(aimag(a))
-
-  exp__ = merge(exp(a%w) * [               cos(absImag), &
-                             a%x/absImag * sin(absImag), &
-                             a%y/absImag * sin(absImag), &
-                             a%z/absImag * sin(absImag)], &
-                IEEE_value(1.0_pReal,IEEE_SIGNALING_NAN), &
-                dNeq0(absImag))
-
-end function exp__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief take logarithm
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function log__(a)
-
-  class(quaternion), intent(in) :: a
-  real(pReal)                   :: absImag
-
-  absImag = norm2(aimag(a))
-
-  log__ = merge([log(abs(a)), &
-                 a%x/absImag * acos(a%w/abs(a)), &
-                 a%y/absImag * acos(a%w/abs(a)), &
-                 a%z/absImag * acos(a%w/abs(a))], &
-                IEEE_value(1.0_pReal,IEEE_SIGNALING_NAN), &
-                dNeq0(absImag))
-
-end function log__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief return norm
-!---------------------------------------------------------------------------------------------------
-real(pReal) elemental pure function abs__(self)
-
-  class(quaternion), intent(in) :: self
-
-  abs__ = norm2([self%w,self%x,self%y,self%z])
-
-end function abs__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief calculate dot product
-!---------------------------------------------------------------------------------------------------
-real(pReal) elemental pure function dot_product__(a,b)
-
-  class(quaternion), intent(in) :: a,b
-
-  dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z
-
-end function dot_product__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief take conjugate complex
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function conjg__(self)
-
-  class(quaternion), intent(in) :: self
-
-  conjg__ = [self%w,-self%x,-self%y,-self%z]
-
-end function conjg__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief homomorph
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function homomorphed(self)
-
-  class(quaternion), intent(in) :: self
-
-  homomorphed = - self
-
-end function homomorphed
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief return as plain array
-!---------------------------------------------------------------------------------------------------
-pure function asArray(self)
-
-  real(pReal), dimension(4)     :: asArray
-  class(quaternion), intent(in) :: self
-
-  asArray = [self%w,self%x,self%y,self%z]
-
-end function asArray
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief real part (scalar)
-!---------------------------------------------------------------------------------------------------
-pure function real__(self)
-
-  real(pReal)                   :: real__
-  class(quaternion), intent(in) :: self
-
-  real__ = self%w
-
-end function real__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief imaginary part (3-vector)
-!---------------------------------------------------------------------------------------------------
-pure function aimag__(self)
-
-  real(pReal), dimension(3)     :: aimag__
-  class(quaternion), intent(in) :: self
-
-  aimag__ = [self%x,self%y,self%z]
-
-end function aimag__
-
-
-!---------------------------------------------------------------------------------------------------
-!> @brief inverse
-!---------------------------------------------------------------------------------------------------
-type(quaternion) elemental pure function inverse(self)
-
-  class(quaternion), intent(in) :: self
-
-  inverse = conjg(self)/abs(self)**2.0_pReal
-
-end function inverse
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief check correctness of some quaternions functions
-!--------------------------------------------------------------------------------------------------
-subroutine selfTest
-
-  real(pReal), dimension(4) :: qu
-  type(quaternion)          :: q, q_2
-
-  if(dNeq(abs(P),1.0_pReal))                           error stop 'P not in {-1,+1}'
-
-  call random_number(qu)
-  qu = (qu-0.5_pReal) * 2.0_pReal
-  q  = quaternion(qu)
-
-  q_2= qu
-  if(any(dNeq(q%asArray(),q_2%asArray())))             error stop 'assign_vec__'
-
-  q_2 = q + q
-  if(any(dNeq(q_2%asArray(),2.0_pReal*qu)))            error stop 'add__'
-
-  q_2 = q - q
-  if(any(dNeq0(q_2%asArray())))                        error stop 'sub__'
-
-  q_2 = q * 5.0_pReal
-  if(any(dNeq(q_2%asArray(),5.0_pReal*qu)))            error stop 'mul__'
-
-  q_2 = q / 0.5_pReal
-  if(any(dNeq(q_2%asArray(),2.0_pReal*qu)))            error stop 'div__'
-
-  q_2 = q * 0.3_pReal
-  if(dNeq0(abs(q)) .and. q_2 == q)                     error stop 'eq__'
-
-  q_2 = q
-  if(q_2 /= q)                                         error stop 'neq__'
-
-  if(dNeq(abs(q),norm2(qu)))                           error stop 'abs__'
-  if(dNeq(abs(q)**2.0_pReal, real(q*q%conjg()),1.0e-14_pReal)) &
-                                                       error stop 'abs__/*conjg'
-
-  if(any(dNeq(q%asArray(),qu)))                        error stop 'eq__'
-  if(dNeq(q%real(),       qu(1)))                      error stop 'real()'
-  if(any(dNeq(q%aimag(),  qu(2:4))))                   error stop 'aimag()'
-
-  q_2 = q%homomorphed()
-  if(q                 /= q_2*    (-1.0_pReal))        error stop 'homomorphed'
-  if(dNeq(q_2%real(),     qu(1)*  (-1.0_pReal)))       error stop 'homomorphed/real'
-  if(any(dNeq(q_2%aimag(),qu(2:4)*(-1.0_pReal))))      error stop 'homomorphed/aimag'
-
-  q_2 = conjg(q)
-  if(dNeq(abs(q),abs(q_2)))                            error stop 'conjg/abs'
-  if(q /= conjg(q_2))                                  error stop 'conjg/involution'
-  if(dNeq(q_2%real(),     q%real()))                   error stop 'conjg/real'
-  if(any(dNeq(q_2%aimag(),q%aimag()*(-1.0_pReal))))    error stop 'conjg/aimag'
-
-  if(abs(q) > 0.0_pReal) then
-    q_2 = q * q%inverse()
-    if(     dNeq(real(q_2), 1.0_pReal,1.0e-15_pReal))  error stop 'inverse/real'
-    if(any(dNeq0(aimag(q_2),          1.0e-15_pReal))) error stop 'inverse/aimag'
-
-    q_2 = q/abs(q)
-    q_2 = conjg(q_2) - inverse(q_2)
-    if(any(dNeq0(q_2%asArray(),1.0e-15_pReal)))        error stop 'inverse/conjg'
-  endif
-  if(dNeq(dot_product(qu,qu),dot_product(q,q)))        error stop 'dot_product'
-
-#if !(defined(__GFORTRAN__) &&  __GNUC__ < 9)
-  if (norm2(aimag(q)) > 0.0_pReal) then
-    if (dNeq0(abs(q-exp(log(q))),1.0e-13_pReal))       error stop 'exp/log'
-    if (dNeq0(abs(q-log(exp(q))),1.0e-13_pReal))       error stop 'log/exp'
-  endif
-#endif
-
-end subroutine selfTest
-
-
-end module quaternions

src/results.f90

@@ -49,7 +49,7 @@ module results
     results_setLink, &
     results_addAttribute, &
     results_removeLink, &
-    results_mapping_constituent, &
+    results_mapping_phase, &
     results_mapping_homogenization
 contains
 
@@ -111,8 +111,6 @@ subroutine results_addIncrement(inc,time)
   call results_closeGroup(results_addGroup(trim('inc'//trim(adjustl(incChar)))))
   call results_setLink(trim('inc'//trim(adjustl(incChar))),'current')
   call results_addAttribute('time/s',time,trim('inc'//trim(adjustl(incChar))))
-  call results_closeGroup(results_addGroup('current/phase'))
-  call results_closeGroup(results_addGroup('current/homogenization'))
 
 end subroutine results_addIncrement
 
@@ -461,7 +459,7 @@ end subroutine results_writeTensorDataset_int
 !--------------------------------------------------------------------------------------------------
 !> @brief adds the unique mapping from spatial position and constituent ID to results
 !--------------------------------------------------------------------------------------------------
-subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
+subroutine results_mapping_phase(phaseAt,memberAtLocal,label)
 
   integer,          dimension(:,:),   intent(in) :: phaseAt                                         !< phase section at (constituent,element)
   integer,          dimension(:,:,:), intent(in) :: memberAtLocal                                   !< phase member at (constituent,IP,element)
@@ -491,6 +489,47 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
   integer(SIZE_T) :: type_size_string, type_size_int
   integer         :: hdferr, ierr, i
 
+!--------------------------------------------------------------------------------------------------
+! prepare MPI communication (transparent for non-MPI runs)
+  call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
+  if(hdferr < 0) error stop 'HDF5 error'
+  memberOffset = 0
+  do i=1, size(label)
+    memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2)                           ! number of points/instance of this process
+  enddo
+  writeSize = 0
+  writeSize(worldrank) = size(memberAtLocal(1,:,:))                                                 ! total number of points by this process
+
+!--------------------------------------------------------------------------------------------------
+! MPI settings and communication
+#ifdef PETSc
+  call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
+  if(hdferr < 0) error stop 'HDF5 error'
+
+  call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)        ! get output at each process
+  if(ierr /= 0) error stop 'MPI error'
+
+  call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process
+  if(ierr /= 0) error stop 'MPI error'
+#endif
+
+  myShape    = int([size(phaseAt,1),writeSize(worldrank)],  HSIZE_T)
+  myOffset   = int([0,sum(writeSize(0:worldrank-1))],       HSIZE_T)
+  totalShape = int([size(phaseAt,1),sum(writeSize)],        HSIZE_T)
+
+
+!---------------------------------------------------------------------------------------------------
+! expand phaseAt to consider IPs (is not stored per IP)
+  do i = 1, size(phaseAtMaterialpoint,2)
+    phaseAtMaterialpoint(:,i,:) = phaseAt
+  enddo
+
+!---------------------------------------------------------------------------------------------------
+! renumber member from my process to all processes
+  do i = 1, size(label)
+    where(phaseAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) -1     ! convert to 0-based
+  enddo
+
 !---------------------------------------------------------------------------------------------------
 ! compound type: name of phase section + position/index within results array
   call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr)
@@ -525,34 +564,6 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
   call h5tclose_f(dt_id, hdferr)
   if(hdferr < 0) error stop 'HDF5 error'
 
-!--------------------------------------------------------------------------------------------------
-! prepare MPI communication (transparent for non-MPI runs)
-  call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
-  if(hdferr < 0) error stop 'HDF5 error'
-  memberOffset = 0
-  do i=1, size(label)
-    memberOffset(i,worldrank) = count(phaseAt == i)*size(memberAtLocal,2)                           ! number of points/instance of this process
-  enddo
-  writeSize = 0
-  writeSize(worldrank) = size(memberAtLocal(1,:,:))                                                 ! total number of points by this process
-
-!--------------------------------------------------------------------------------------------------
-! MPI settings and communication
-#ifdef PETSc
-  call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
-  if(hdferr < 0) error stop 'HDF5 error'
-
-  call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)        ! get output at each process
-  if(ierr /= 0) error stop 'MPI error'
-
-  call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process
-  if(ierr /= 0) error stop 'MPI error'
-#endif
-
-  myShape    = int([size(phaseAt,1),writeSize(worldrank)],  HSIZE_T)
-  myOffset   = int([0,sum(writeSize(0:worldrank-1))],       HSIZE_T)
-  totalShape = int([size(phaseAt,1),sum(writeSize)],        HSIZE_T)
-
 !--------------------------------------------------------------------------------------------------
 ! create dataspace in memory (local shape = hyperslab) and in file (global shape)
   call h5screate_simple_f(2,myShape,memspace_id,hdferr,myShape)
@@ -564,18 +575,6 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
   call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr)
   if(hdferr < 0) error stop 'HDF5 error'
 
-!---------------------------------------------------------------------------------------------------
-! expand phaseAt to consider IPs (is not stored per IP)
-  do i = 1, size(phaseAtMaterialpoint,2)
-    phaseAtMaterialpoint(:,i,:) = phaseAt
-  enddo
-
-!---------------------------------------------------------------------------------------------------
-! renumber member from my process to all processes
-  do i = 1, size(label)
-    where(phaseAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) -1     ! convert to 0-based
-  enddo
-
 !--------------------------------------------------------------------------------------------------
 ! write the components of the compound type individually
   call h5pset_preserve_f(plist_id, .TRUE., hdferr)
@@ -609,7 +608,7 @@ subroutine results_mapping_constituent(phaseAt,memberAtLocal,label)
   if(hdferr < 0) error stop 'HDF5 error'
   call h5tclose_f(position_id, hdferr)
 
-end subroutine results_mapping_constituent
+end subroutine results_mapping_phase
 
 
 !--------------------------------------------------------------------------------------------------
@@ -645,6 +644,48 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label)
   integer(SIZE_T) :: type_size_string, type_size_int
   integer         :: hdferr, ierr, i
 
+
+!--------------------------------------------------------------------------------------------------
+! prepare MPI communication (transparent for non-MPI runs)
+  call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
+  if(hdferr < 0) error stop 'HDF5 error'
+  memberOffset = 0
+  do i=1, size(label)
+    memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1)                  ! number of points/instance of this process
+  enddo
+  writeSize = 0
+  writeSize(worldrank) = size(memberAtLocal)                                                        ! total number of points by this process
+
+!--------------------------------------------------------------------------------------------------
+! MPI settings and communication
+#ifdef PETSc
+  call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
+  if(hdferr < 0) error stop 'HDF5 error'
+
+  call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)        ! get output at each process
+  if(ierr /= 0) error stop 'MPI error'
+
+  call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process
+  if(ierr /= 0) error stop 'MPI error'
+#endif
+
+  myShape    = int([writeSize(worldrank)],          HSIZE_T)
+  myOffset   = int([sum(writeSize(0:worldrank-1))], HSIZE_T)
+  totalShape = int([sum(writeSize)],                HSIZE_T)
+
+
+!---------------------------------------------------------------------------------------------------
+! expand phaseAt to consider IPs (is not stored per IP)
+  do i = 1, size(homogenizationAtMaterialpoint,1)
+    homogenizationAtMaterialpoint(i,:) = homogenizationAt
+  enddo
+
+!---------------------------------------------------------------------------------------------------
+! renumber member from my process to all processes
+  do i = 1, size(label)
+    where(homogenizationAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) - 1  ! convert to 0-based
+  enddo
+
 !---------------------------------------------------------------------------------------------------
 ! compound type: name of phase section + position/index within results array
   call h5tcopy_f(H5T_NATIVE_CHARACTER, dt_id, hdferr)
@@ -679,34 +720,6 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label)
   call h5tclose_f(dt_id, hdferr)
   if(hdferr < 0) error stop 'HDF5 error'
 
-!--------------------------------------------------------------------------------------------------
-! prepare MPI communication (transparent for non-MPI runs)
-  call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr)
-  if(hdferr < 0) error stop 'HDF5 error'
-  memberOffset = 0
-  do i=1, size(label)
-    memberOffset(i,worldrank) = count(homogenizationAt == i)*size(memberAtLocal,1)                  ! number of points/instance of this process
-  enddo
-  writeSize = 0
-  writeSize(worldrank) = size(memberAtLocal)                                                        ! total number of points by this process
-
-!--------------------------------------------------------------------------------------------------
-! MPI settings and communication
-#ifdef PETSc
-  call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr)
-  if(hdferr < 0) error stop 'HDF5 error'
-
-  call MPI_allreduce(MPI_IN_PLACE,writeSize,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)        ! get output at each process
-  if(ierr /= 0) error stop 'MPI error'
-
-  call MPI_allreduce(MPI_IN_PLACE,memberOffset,size(memberOffset),MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)! get offset at each process
-  if(ierr /= 0) error stop 'MPI error'
-#endif
-
-  myShape    = int([writeSize(worldrank)],          HSIZE_T)
-  myOffset   = int([sum(writeSize(0:worldrank-1))], HSIZE_T)
-  totalShape = int([sum(writeSize)],                HSIZE_T)
-
 !--------------------------------------------------------------------------------------------------
 ! create dataspace in memory (local shape = hyperslab) and in file (global shape)
   call h5screate_simple_f(1,myShape,memspace_id,hdferr,myShape)
@@ -718,18 +731,6 @@ subroutine results_mapping_homogenization(homogenizationAt,memberAtLocal,label)
   call h5sselect_hyperslab_f(filespace_id, H5S_SELECT_SET_F, myOffset, myShape, hdferr)
   if(hdferr < 0) error stop 'HDF5 error'
 
-!---------------------------------------------------------------------------------------------------
-! expand phaseAt to consider IPs (is not stored per IP)
-  do i = 1, size(homogenizationAtMaterialpoint,1)
-    homogenizationAtMaterialpoint(i,:) = homogenizationAt
-  enddo
-
-!---------------------------------------------------------------------------------------------------
-! renumber member from my process to all processes
-  do i = 1, size(label)
-    where(homogenizationAtMaterialpoint == i) memberAtGlobal = memberAtLocal + sum(memberOffset(i,0:worldrank-1)) - 1  ! convert to 0-based
-  enddo
-
 !--------------------------------------------------------------------------------------------------
 ! write the components of the compound type individually
   call h5pset_preserve_f(plist_id, .TRUE., hdferr)

src/rotations.f90

@@ -47,16 +47,16 @@
 !---------------------------------------------------------------------------------------------------
 
 module rotations
-  use prec
   use IO
   use math
-  use quaternions
 
   implicit none
   private
 
+  real(pReal), parameter :: P = -1.0_pReal                                                          !< parameter for orientation conversion.
+
   type, public :: rotation
-    type(quaternion) :: q
+    real(pReal), dimension(4) :: q
     contains
       procedure, public :: asQuaternion
       procedure, public :: asEulers
@@ -103,7 +103,6 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine rotations_init
 
-  call quaternions_init
   print'(/,a)', ' <<<+-  rotations init  -+>>>'; flush(IO_STDOUT)
 
   print*, 'Rowenhorst et al., Modelling and Simulation in Materials Science and Engineering 23:083501, 2015'
@@ -122,7 +121,7 @@ pure function asQuaternion(self)
   class(rotation), intent(in) :: self
   real(pReal), dimension(4)   :: asQuaternion
 
-  asQuaternion = self%q%asArray()
+  asQuaternion = self%q
 
 end function asQuaternion
 !---------------------------------------------------------------------------------------------------
@@ -131,7 +130,7 @@ pure function asEulers(self)
   class(rotation), intent(in) :: self
   real(pReal), dimension(3)   :: asEulers
 
-  asEulers = qu2eu(self%q%asArray())
+  asEulers = qu2eu(self%q)
 
 end function asEulers
 !---------------------------------------------------------------------------------------------------
@@ -140,7 +139,7 @@ pure function asAxisAngle(self)
   class(rotation), intent(in) :: self
   real(pReal), dimension(4)   :: asAxisAngle
 
-  asAxisAngle = qu2ax(self%q%asArray())
+  asAxisAngle = qu2ax(self%q)
 
 end function asAxisAngle
 !---------------------------------------------------------------------------------------------------
@@ -149,7 +148,7 @@ pure function asMatrix(self)
   class(rotation), intent(in) :: self
   real(pReal), dimension(3,3) :: asMatrix
 
-  asMatrix = qu2om(self%q%asArray())
+  asMatrix = qu2om(self%q)
 
 end function asMatrix
 !---------------------------------------------------------------------------------------------------
@@ -158,7 +157,7 @@ pure function asRodrigues(self)
   class(rotation), intent(in) :: self
   real(pReal), dimension(4)   :: asRodrigues
 
-  asRodrigues = qu2ro(self%q%asArray())
+  asRodrigues = qu2ro(self%q)
 
 end function asRodrigues
 !---------------------------------------------------------------------------------------------------
@@ -167,7 +166,7 @@ pure function asHomochoric(self)
   class(rotation), intent(in) :: self
   real(pReal), dimension(3)   :: asHomochoric
 
-  asHomochoric = qu2ho(self%q%asArray())
+  asHomochoric = qu2ho(self%q)
 
 end function asHomochoric
 
@@ -259,7 +258,7 @@ pure elemental function rotRot__(self,R) result(rRot)
   type(rotation)              :: rRot
   class(rotation), intent(in) :: self,R
 
-  rRot = rotation(self%q*R%q)
+  rRot = rotation(multiply_quaternion(self%q,R%q))
   call rRot%standardize()
 
 end function rotRot__
@@ -272,14 +271,14 @@ pure elemental subroutine standardize(self)
 
   class(rotation), intent(inout) :: self
 
-  if (real(self%q) < 0.0_pReal) self%q = self%q%homomorphed()
+  if (self%q(1) < 0.0_pReal) self%q = - self%q
 
 end subroutine standardize
 
 
 !---------------------------------------------------------------------------------------------------
 !> @author Marc De Graef, Carnegie Mellon University
-!> @brief rotate a vector passively (default) or actively
+!> @brief Rotate a vector passively (default) or actively.
 !---------------------------------------------------------------------------------------------------
 pure function rotVector(self,v,active) result(vRot)
 
@@ -288,9 +287,8 @@ pure function rotVector(self,v,active) result(vRot)
   real(pReal),     intent(in), dimension(3) :: v
   logical,         intent(in), optional     :: active
 
-  real(pReal),    dimension(3) :: v_normed
+  real(pReal), dimension(4) :: v_normed, q
-  type(quaternion)             :: q
+  logical                   :: passive
-  logical                      :: passive
 
   if (present(active)) then
     passive = .not. active
@@ -301,13 +299,13 @@ pure function rotVector(self,v,active) result(vRot)
   if (dEq0(norm2(v))) then
     vRot = v
   else
-    v_normed = v/norm2(v)
+    v_normed = [0.0_pReal,v]/norm2(v)
     if (passive) then
-      q = self%q * (quaternion([0.0_pReal, v_normed(1), v_normed(2), v_normed(3)]) * conjg(self%q) )
+      q = multiply_quaternion(self%q, multiply_quaternion(v_normed, conjugate_quaternion(self%q)))
     else
-      q = conjg(self%q) * (quaternion([0.0_pReal, v_normed(1), v_normed(2), v_normed(3)]) * self%q )
+      q = multiply_quaternion(conjugate_quaternion(self%q), multiply_quaternion(v_normed, self%q))
     endif
-    vRot = q%aimag()*norm2(v)
+    vRot = q(2:4)*norm2(v)
   endif
 
 end function rotVector
@@ -315,8 +313,8 @@ end function rotVector
 
 !---------------------------------------------------------------------------------------------------
 !> @author Marc De Graef, Carnegie Mellon University
-!> @brief rotate a rank-2 tensor passively (default) or actively
+!> @brief Rotate a rank-2 tensor passively (default) or actively.
-!> @details: rotation is based on rotation matrix
+!> @details: Rotation is based on rotation matrix
 !---------------------------------------------------------------------------------------------------
 pure function rotTensor2(self,T,active) result(tRot)
 
@@ -403,7 +401,7 @@ pure elemental function misorientation(self,other)
   type(rotation)              :: misorientation
   class(rotation), intent(in) :: self, other
 
-  misorientation%q = other%q * conjg(self%q)
+  misorientation%q = multiply_quaternion(other%q, conjugate_quaternion(self%q))
 
 end function misorientation
 
@@ -1338,7 +1336,7 @@ end function cu2ho
 !--------------------------------------------------------------------------
 !> @author Marc De Graef, Carnegie Mellon University
 !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief determine to which pyramid a point in a cubic grid belongs
+!> @brief Determine to which pyramid a point in a cubic grid belongs.
 !--------------------------------------------------------------------------
 pure function GetPyramidOrder(xyz)
 
@@ -1362,7 +1360,39 @@ end function GetPyramidOrder
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief check correctness of some rotations functions
+!> @brief Multiply two quaternions.
+!--------------------------------------------------------------------------------------------------
+pure function multiply_quaternion(qu1,qu2)
+
+  real(pReal), dimension(4), intent(in) :: qu1, qu2
+  real(pReal), dimension(4) :: multiply_quaternion
+
+
+  multiply_quaternion(1) = qu1(1)*qu2(1) - qu1(2)*qu2(2) -      qu1(3)*qu2(3) - qu1(4)*qu2(4)
+  multiply_quaternion(2) = qu1(1)*qu2(2) + qu1(2)*qu2(1) + P * (qu1(3)*qu2(4) - qu1(4)*qu2(3))
+  multiply_quaternion(3) = qu1(1)*qu2(3) + qu1(3)*qu2(1) + P * (qu1(4)*qu2(2) - qu1(2)*qu2(4))
+  multiply_quaternion(4) = qu1(1)*qu2(4) + qu1(4)*qu2(1) + P * (qu1(2)*qu2(3) - qu1(3)*qu2(2))
+
+end function multiply_quaternion
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Calculate conjugate complex of a quaternion.
+!--------------------------------------------------------------------------------------------------
+pure function conjugate_quaternion(qu)
+
+  real(pReal), dimension(4), intent(in) :: qu
+  real(pReal), dimension(4) :: conjugate_quaternion
+
+
+  conjugate_quaternion = [qu(1), -qu(2), -qu(3), -qu(4)]
+
+
+end function conjugate_quaternion
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief Check correctness of some rotations functions.
 !--------------------------------------------------------------------------------------------------
 subroutine selfTest
 
@@ -1374,7 +1404,8 @@ subroutine selfTest
   real    :: A,B
   integer :: i
 
-  do i=1,10
+
+  do i = 1, 10
 
 #if defined(__GFORTRAN__) && __GNUC__<9
     if(i<7) cycle

src/source_damage_anisoBrittle.f90

@@ -101,9 +101,9 @@ module function source_damage_anisoBrittle_init(source_length) result(mySources)
         if (any(prm%s_crit <  0.0_pReal)) extmsg = trim(extmsg)//' s_crit'
 
         Nconstituents = count(material_phaseAt==p) * discretization_nIPs
-        call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0)
+        call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0)
-        sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal)
+        damageState(p)%p(sourceOffset)%atol = src%get_asFloat('anisobrittle_atol',defaultVal=1.0e-3_pReal)
-        if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol'
+        if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisobrittle_atol'
 
         end associate
 
@@ -120,10 +120,10 @@ end function source_damage_anisoBrittle_init
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates derived quantities from state
 !--------------------------------------------------------------------------------------------------
-module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
+module subroutine source_damage_anisoBrittle_dotState(S, co, ip, el)
 
   integer, intent(in) :: &
-    ipc, &                                                                                          !< component-ID of integration point
+    co, &                                                                                          !< component-ID of integration point
     ip, &                                                                                           !< integration point
     el                                                                                              !< element
   real(pReal),  intent(in), dimension(3,3) :: &
@@ -139,14 +139,14 @@ module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
   real(pReal) :: &
     traction_d, traction_t, traction_n, traction_crit
 
-  phase = material_phaseAt(ipc,el)
+  phase = material_phaseAt(co,el)
-  constituent = material_phasememberAt(ipc,ip,el)
+  constituent = material_phasememberAt(co,ip,el)
   sourceOffset = source_damage_anisoBrittle_offset(phase)
   homog = material_homogenizationAt(el)
-  damageOffset = damageMapping(homog)%p(ip,el)
+  damageOffset = material_homogenizationMemberAt(ip,el)
 
   associate(prm => param(source_damage_anisoBrittle_instance(phase)))
-  sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal
+  damageState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal
   do i = 1, prm%sum_N_cl
     traction_d    = math_tensordot(S,prm%cleavage_systems(1:3,1:3,1,i))
     traction_t    = math_tensordot(S,prm%cleavage_systems(1:3,1:3,2,i))
@@ -154,8 +154,8 @@ module subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
 
     traction_crit = prm%g_crit(i)*damage(homog)%p(damageOffset)**2.0_pReal
 
-    sourceState(phase)%p(sourceOffset)%dotState(1,constituent) &
+    damageState(phase)%p(sourceOffset)%dotState(1,constituent) &
-    = sourceState(phase)%p(sourceOffset)%dotState(1,constituent) &
+    = damageState(phase)%p(sourceOffset)%dotState(1,constituent) &
     + prm%dot_o / prm%s_crit(i) &
       * ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**prm%q + &
          (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**prm%q + &
@@ -185,7 +185,7 @@ module subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, d
 
   sourceOffset = source_damage_anisoBrittle_offset(phase)
 
-  dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
+  dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent)
 
   localphiDot = 1.0_pReal &
               + dLocalphiDot_dPhi*phi
@@ -204,7 +204,7 @@ module subroutine source_damage_anisoBrittle_results(phase,group)
   integer :: o
 
   associate(prm => param(source_damage_anisoBrittle_instance(phase)), &
-            stt => sourceState(phase)%p(source_damage_anisoBrittle_offset(phase))%state)
+            stt => damageState(phase)%p(source_damage_anisoBrittle_offset(phase))%state)
   outputsLoop: do o = 1,size(prm%output)
     select case(trim(prm%output(o)))
       case ('f_phi')

src/source_damage_anisoDuctile.f90

@@ -87,9 +87,9 @@ module function source_damage_anisoDuctile_init(source_length) result(mySources)
         if (any(prm%gamma_crit <  0.0_pReal)) extmsg = trim(extmsg)//' gamma_crit'
 
         Nconstituents=count(material_phaseAt==p) * discretization_nIPs
-        call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0)
+        call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0)
-        sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal)
+        damageState(p)%p(sourceOffset)%atol = src%get_asFloat('anisoDuctile_atol',defaultVal=1.0e-3_pReal)
-        if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol'
+        if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' anisoductile_atol'
 
         end associate
 
@@ -107,10 +107,10 @@ end function source_damage_anisoDuctile_init
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates derived quantities from state
 !--------------------------------------------------------------------------------------------------
-module subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
+module subroutine source_damage_anisoDuctile_dotState(co, ip, el)
 
   integer, intent(in) :: &
-    ipc, &                                                                                          !< component-ID of integration point
+    co, &                                                                                          !< component-ID of integration point
     ip, &                                                                                           !< integration point
     el                                                                                              !< element
 
@@ -121,14 +121,14 @@ module subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
     damageOffset, &
     homog
 
-  phase = material_phaseAt(ipc,el)
+  phase = material_phaseAt(co,el)
-  constituent = material_phasememberAt(ipc,ip,el)
+  constituent = material_phasememberAt(co,ip,el)
   sourceOffset = source_damage_anisoDuctile_offset(phase)
   homog = material_homogenizationAt(el)
-  damageOffset = damageMapping(homog)%p(ip,el)
+  damageOffset = material_homogenizationMemberAt(ip,el)
 
   associate(prm => param(source_damage_anisoDuctile_instance(phase)))
-  sourceState(phase)%p(sourceOffset)%dotState(1,constituent) &
+  damageState(phase)%p(sourceOffset)%dotState(1,constituent) &
     = sum(plasticState(phase)%slipRate(:,constituent)/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit)
   end associate
 
@@ -154,7 +154,7 @@ module subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, d
 
   sourceOffset = source_damage_anisoDuctile_offset(phase)
 
-  dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
+  dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent)
 
   localphiDot = 1.0_pReal &
               + dLocalphiDot_dPhi*phi
@@ -173,7 +173,7 @@ module subroutine source_damage_anisoDuctile_results(phase,group)
   integer :: o
 
   associate(prm => param(source_damage_anisoDuctile_instance(phase)), &
-            stt => sourceState(phase)%p(source_damage_anisoDuctile_offset(phase))%state)
+            stt => damageState(phase)%p(source_damage_anisoDuctile_offset(phase))%state)
   outputsLoop: do o = 1,size(prm%output)
     select case(trim(prm%output(o)))
       case ('f_phi')

src/source_damage_isoBrittle.f90

@@ -74,9 +74,9 @@ module function source_damage_isoBrittle_init(source_length) result(mySources)
         if (prm%W_crit <= 0.0_pReal) extmsg = trim(extmsg)//' W_crit'
 
         Nconstituents = count(material_phaseAt==p) * discretization_nIPs
-        call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,1)
+        call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,1)
-        sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal)
+        damageState(p)%p(sourceOffset)%atol = src%get_asFloat('isoBrittle_atol',defaultVal=1.0e-3_pReal)
-        if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol'
+        if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isobrittle_atol'
 
         end associate
 
@@ -94,10 +94,10 @@ end function source_damage_isoBrittle_init
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates derived quantities from state
 !--------------------------------------------------------------------------------------------------
-module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
+module subroutine source_damage_isoBrittle_deltaState(C, Fe, co, ip, el)
 
   integer, intent(in) :: &
-    ipc, &                                                                                          !< component-ID of integration point
+    co, &                                                                                          !< component-ID of integration point
     ip, &                                                                                           !< integration point
     el                                                                                              !< element
   real(pReal),  intent(in), dimension(3,3) :: &
@@ -114,8 +114,8 @@ module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
   real(pReal) :: &
     strainenergy
 
-  phase = material_phaseAt(ipc,el)                                                                  !< phase ID at ipc,ip,el
+  phase = material_phaseAt(co,el)                                                                  !< phase ID at co,ip,el
-  constituent = material_phasememberAt(ipc,ip,el)                                                   !< state array offset for phase ID at ipc,ip,el
+  constituent = material_phasememberAt(co,ip,el)                                                   !< state array offset for phase ID at co,ip,el
   sourceOffset = source_damage_isoBrittle_offset(phase)
 
   strain = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3)
@@ -124,13 +124,13 @@ module subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
   strainenergy = 2.0_pReal*sum(strain*matmul(C,strain))/prm%W_crit
   ! ToDo: check strainenergy = 2.0_pReal*dot_product(strain,matmul(C,strain))/prm%W_crit
 
-  if (strainenergy > sourceState(phase)%p(sourceOffset)%subState0(1,constituent)) then
+  if (strainenergy > damageState(phase)%p(sourceOffset)%subState0(1,constituent)) then
-    sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
+    damageState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
-      strainenergy - sourceState(phase)%p(sourceOffset)%state(1,constituent)
+      strainenergy - damageState(phase)%p(sourceOffset)%state(1,constituent)
   else
-    sourceState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
+    damageState(phase)%p(sourceOffset)%deltaState(1,constituent) = &
-      sourceState(phase)%p(sourceOffset)%subState0(1,constituent) - &
+      damageState(phase)%p(sourceOffset)%subState0(1,constituent) - &
-      sourceState(phase)%p(sourceOffset)%state(1,constituent)
+      damageState(phase)%p(sourceOffset)%state(1,constituent)
   endif
   end associate
 
@@ -158,8 +158,8 @@ module subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLo
 
   associate(prm => param(source_damage_isoBrittle_instance(phase)))
   localphiDot = 1.0_pReal &
-              - phi*sourceState(phase)%p(sourceOffset)%state(1,constituent)
+              - phi*damageState(phase)%p(sourceOffset)%state(1,constituent)
-  dLocalphiDot_dPhi = - sourceState(phase)%p(sourceOffset)%state(1,constituent)
+  dLocalphiDot_dPhi = - damageState(phase)%p(sourceOffset)%state(1,constituent)
   end associate
 
 end subroutine source_damage_isoBrittle_getRateAndItsTangent
@@ -176,7 +176,7 @@ module subroutine source_damage_isoBrittle_results(phase,group)
   integer :: o
 
   associate(prm => param(source_damage_isoBrittle_instance(phase)), &
-            stt => sourceState(phase)%p(source_damage_isoBrittle_offset(phase))%state)
+            stt => damageState(phase)%p(source_damage_isoBrittle_offset(phase))%state)
   outputsLoop: do o = 1,size(prm%output)
     select case(trim(prm%output(o)))
       case ('f_phi')

src/source_damage_isoDuctile.f90

@@ -78,9 +78,9 @@ module function source_damage_isoDuctile_init(source_length) result(mySources)
         if (prm%gamma_crit <= 0.0_pReal) extmsg = trim(extmsg)//' gamma_crit'
 
         Nconstituents=count(material_phaseAt==p) * discretization_nIPs
-        call constitutive_allocateState(sourceState(p)%p(sourceOffset),Nconstituents,1,1,0)
+        call constitutive_allocateState(damageState(p)%p(sourceOffset),Nconstituents,1,1,0)
-        sourceState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal)
+        damageState(p)%p(sourceOffset)%atol = src%get_asFloat('isoDuctile_atol',defaultVal=1.0e-3_pReal)
-        if(any(sourceState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol'
+        if(any(damageState(p)%p(sourceOffset)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' isoductile_atol'
 
         end associate
 
@@ -98,10 +98,10 @@ end function source_damage_isoDuctile_init
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates derived quantities from state
 !--------------------------------------------------------------------------------------------------
-module subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
+module subroutine source_damage_isoDuctile_dotState(co, ip, el)
 
   integer, intent(in) :: &
-    ipc, &                                                                                          !< component-ID of integration point
+    co, &                                                                                          !< component-ID of integration point
     ip, &                                                                                           !< integration point
     el                                                                                              !< element
 
@@ -112,14 +112,14 @@ module subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
     damageOffset, &
     homog
 
-  phase = material_phaseAt(ipc,el)
+  phase = material_phaseAt(co,el)
-  constituent = material_phasememberAt(ipc,ip,el)
+  constituent = material_phasememberAt(co,ip,el)
   sourceOffset = source_damage_isoDuctile_offset(phase)
   homog = material_homogenizationAt(el)
-  damageOffset = damageMapping(homog)%p(ip,el)
+  damageOffset = material_homogenizationMemberAt(ip,el)
 
   associate(prm => param(source_damage_isoDuctile_instance(phase)))
-  sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = &
+  damageState(phase)%p(sourceOffset)%dotState(1,constituent) = &
     sum(plasticState(phase)%slipRate(:,constituent))/(damage(homog)%p(damageOffset)**prm%q)/prm%gamma_crit
   end associate
 
@@ -145,7 +145,7 @@ module subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLo
 
   sourceOffset = source_damage_isoDuctile_offset(phase)
 
-  dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
+  dLocalphiDot_dPhi = -damageState(phase)%p(sourceOffset)%state(1,constituent)
 
   localphiDot = 1.0_pReal &
               + dLocalphiDot_dPhi*phi
@@ -164,7 +164,7 @@ module subroutine source_damage_isoDuctile_results(phase,group)
   integer :: o
 
   associate(prm => param(source_damage_isoDuctile_instance(phase)), &
-            stt => sourceState(phase)%p(source_damage_isoDuctile_offset(phase))%state)
+            stt => damageState(phase)%p(source_damage_isoDuctile_offset(phase))%state)
   outputsLoop: do o = 1,size(prm%output)
     select case(trim(prm%output(o)))
       case ('f_phi')

src/thermal_adiabatic.f90

@@ -1,229 +0,0 @@
-!--------------------------------------------------------------------------------------------------
-!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief material subroutine for adiabatic temperature evolution
-!--------------------------------------------------------------------------------------------------
-module thermal_adiabatic
-  use prec
-  use config
-  use material
-  use results
-  use constitutive
-  use YAML_types
-  use crystallite
-  use lattice
-
-  implicit none
-  private
-
-  type :: tParameters
-    character(len=pStringLen), allocatable, dimension(:) :: &
-      output
-  end type tParameters
-  
-  type(tparameters),             dimension(:), allocatable :: &
-    param
- 
-  public :: &
-    thermal_adiabatic_init, &
-    thermal_adiabatic_updateState, &
-    thermal_adiabatic_getSourceAndItsTangent, &
-    thermal_adiabatic_getSpecificHeat, &
-    thermal_adiabatic_getMassDensity, &
-    thermal_adiabatic_results
- 
-contains
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief module initialization
-!> @details reads in material parameters, allocates arrays, and does sanity checks
-!--------------------------------------------------------------------------------------------------
-subroutine thermal_adiabatic_init
- 
-  integer :: maxNinstances,h,Nmaterialpoints
-  class(tNode), pointer :: &
-    material_homogenization, &
-    homog, &
-    homogThermal
-
-  print'(/,a)', ' <<<+-  thermal_adiabatic init  -+>>>'; flush(6)
-  
-  maxNinstances = count(thermal_type == THERMAL_adiabatic_ID)
-  if (maxNinstances == 0) return
-  
-  allocate(param(maxNinstances))
-  
-  material_homogenization => config_material%get('homogenization')
-  do h = 1, size(material_name_homogenization)
-    if (thermal_type(h) /= THERMAL_adiabatic_ID) cycle
-    homog => material_homogenization%get(h)
-    homogThermal => homog%get('thermal')
- 
-    associate(prm => param(thermal_typeInstance(h)))
-
-#if defined (__GFORTRAN__)
-    prm%output = output_asStrings(homogThermal)
-#else
-    prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray)
-#endif
-
-    Nmaterialpoints=count(material_homogenizationAt==h)
-    thermalState(h)%sizeState = 1
-    allocate(thermalState(h)%state0   (1,Nmaterialpoints), source=thermal_initialT(h))
-    allocate(thermalState(h)%subState0(1,Nmaterialpoints), source=thermal_initialT(h))
-    allocate(thermalState(h)%state    (1,Nmaterialpoints), source=thermal_initialT(h))
- 
-    thermalMapping(h)%p => material_homogenizationMemberAt
-    deallocate(temperature(h)%p)
-    temperature(h)%p => thermalState(h)%state(1,:)
-    deallocate(temperatureRate(h)%p)
-    allocate  (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal)
-  
-    end associate
-  enddo
- 
-end subroutine thermal_adiabatic_init
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief  calculates adiabatic change in temperature based on local heat generation model  
-!--------------------------------------------------------------------------------------------------
-function thermal_adiabatic_updateState(subdt, ip, el)
-  
-  integer,     intent(in) :: &
-    ip, &                                                                                           !< integration point number
-    el                                                                                              !< element number
-  real(pReal), intent(in) :: &
-    subdt
-
-  logical, dimension(2)  :: &
-    thermal_adiabatic_updateState
-  integer :: &
-    homog, &
-    offset
-  real(pReal) :: &
-    T, Tdot, dTdot_dT  
- 
-  homog  = material_homogenizationAt(el)
-  offset = material_homogenizationMemberAt(ip,el)
-  
-  T = thermalState(homog)%subState0(1,offset)
-  call thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
-  T = T + subdt*Tdot/(thermal_adiabatic_getSpecificHeat(ip,el)*thermal_adiabatic_getMassDensity(ip,el))
-  
-  thermal_adiabatic_updateState = [     abs(T - thermalState(homog)%state(1,offset)) &
-                                     <= 1.0e-2_pReal &
-                                   .or. abs(T - thermalState(homog)%state(1,offset)) &
-                                     <= 1.0e-6_pReal*abs(thermalState(homog)%state(1,offset)), &
-                                   .true.]
- 
-  temperature    (homog)%p(thermalMapping(homog)%p(ip,el)) = T  
-  temperatureRate(homog)%p(thermalMapping(homog)%p(ip,el)) = &
-    (thermalState(homog)%state(1,offset) - thermalState(homog)%subState0(1,offset))/(subdt+tiny(0.0_pReal))
-  
-end function thermal_adiabatic_updateState
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief returns heat generation rate
-!--------------------------------------------------------------------------------------------------
-subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
- 
-  integer,     intent(in) :: &
-    ip, &                                                                                           !< integration point number
-    el                                                                                              !< element number
-  real(pReal), intent(in) :: &
-    T
-  real(pReal), intent(out) :: &
-    Tdot, dTdot_dT
-  integer :: &
-    homog
- 
-  Tdot = 0.0_pReal
-  dTdot_dT = 0.0_pReal
- 
-  homog  = material_homogenizationAt(el)
-  call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, crystallite_S, crystallite_Lp, ip, el)
-
-  Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal)
-  dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal)
- 
-end subroutine thermal_adiabatic_getSourceAndItsTangent
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized specific heat capacity
-!--------------------------------------------------------------------------------------------------
-function thermal_adiabatic_getSpecificHeat(ip,el)
- 
-  integer, intent(in) :: &
-    ip, &                                                                                           !< integration point number
-    el                                                                                              !< element number
-  
-  real(pReal) :: &
-    thermal_adiabatic_getSpecificHeat
-  integer :: &
-    grain
-   
-  thermal_adiabatic_getSpecificHeat = 0.0_pReal
-  
-  do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
-    thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat & 
-                                      + lattice_c_p(material_phaseAt(grain,el))
-  enddo
- 
-  thermal_adiabatic_getSpecificHeat = thermal_adiabatic_getSpecificHeat &
-                                    / real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal)
-  
-end function thermal_adiabatic_getSpecificHeat
- 
- 
-!--------------------------------------------------------------------------------------------------
-!> @brief returns homogenized mass density
-!--------------------------------------------------------------------------------------------------
-function thermal_adiabatic_getMassDensity(ip,el)
-    
-  integer, intent(in) :: &
-    ip, &                                                                                           !< integration point number
-    el                                                                                              !< element number
-  real(pReal) :: &
-    thermal_adiabatic_getMassDensity
-  integer :: &
-    grain
-   
-  thermal_adiabatic_getMassDensity = 0.0_pReal
- 
-  do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
-    thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity &
-                                     + lattice_rho(material_phaseAt(grain,el))
-  enddo
- 
-  thermal_adiabatic_getMassDensity = thermal_adiabatic_getMassDensity &
-                                   / real(homogenization_Nconstituents(material_homogenizationAt(el)),pReal)
- 
-end function thermal_adiabatic_getMassDensity
-
-
-!--------------------------------------------------------------------------------------------------
-!> @brief writes results to HDF5 output file
-!--------------------------------------------------------------------------------------------------
-subroutine thermal_adiabatic_results(homog,group)
-
-  integer,          intent(in) :: homog
-  character(len=*), intent(in) :: group
-
-  integer :: o
-  
-  associate(prm => param(damage_typeInstance(homog)))
-  outputsLoop: do o = 1,size(prm%output)
-    select case(trim(prm%output(o)))
-      case('T') 
-        call results_writeDataset(group,temperature(homog)%p,'T',&
-                                  'temperature','K')
-    end select
-  enddo outputsLoop
-  end associate
-
-end subroutine thermal_adiabatic_results
-
-end module thermal_adiabatic

src/thermal_conduction.f90

@@ -8,9 +8,9 @@ module thermal_conduction
   use config
   use lattice
   use results
-  use crystallite
   use constitutive
   use YAML_types
+  use discretization
 
   implicit none
   private
@@ -25,7 +25,7 @@ module thermal_conduction
 
   public :: &
     thermal_conduction_init, &
-    thermal_conduction_getSourceAndItsTangent, &
+    thermal_conduction_getSource, &
     thermal_conduction_getConductivity, &
     thermal_conduction_getSpecificHeat, &
     thermal_conduction_getMassDensity, &
@@ -39,25 +39,28 @@ contains
 !> @brief module initialization
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
-subroutine thermal_conduction_init
+subroutine thermal_conduction_init(T)
 
-  integer :: Ninstances,Nmaterialpoints,h
+  real(pReal), dimension(:), intent(inout) ::  T
+
+  integer :: Ninstances,Nmaterialpoints,ho,ip,el,ce
   class(tNode), pointer :: &
     material_homogenization, &
     homog, &
     homogThermal
 
+
   print'(/,a)', ' <<<+-  thermal_conduction init  -+>>>'; flush(6)
 
   Ninstances = count(thermal_type == THERMAL_conduction_ID)
   allocate(param(Ninstances))
 
   material_homogenization => config_material%get('homogenization')
-  do h = 1, size(material_name_homogenization)
+  do ho = 1, size(material_name_homogenization)
-    if (thermal_type(h) /= THERMAL_conduction_ID) cycle
+    if (thermal_type(ho) /= THERMAL_conduction_ID) cycle
-    homog => material_homogenization%get(h)
+    homog => material_homogenization%get(ho)
     homogThermal => homog%get('thermal')
-    associate(prm => param(thermal_typeInstance(h)))
+    associate(prm => param(thermal_typeInstance(ho)))
 
 #if defined (__GFORTRAN__)
     prm%output = output_asStrings(homogThermal)
@@ -65,28 +68,30 @@ subroutine thermal_conduction_init
     prm%output = homogThermal%get_asStrings('output',defaultVal=emptyStringArray)
 #endif
 
-    Nmaterialpoints=count(material_homogenizationAt==h)
+    Nmaterialpoints=count(material_homogenizationAt==ho)
-    thermalState(h)%sizeState = 0
-    allocate(thermalState(h)%state0   (0,Nmaterialpoints))
-    allocate(thermalState(h)%subState0(0,Nmaterialpoints))
-    allocate(thermalState(h)%state    (0,Nmaterialpoints))
 
-    thermalMapping(h)%p => material_homogenizationMemberAt
+    allocate  (temperature    (ho)%p(Nmaterialpoints), source=thermal_initialT(ho))
-    deallocate(temperature    (h)%p)
+    allocate  (temperatureRate(ho)%p(Nmaterialpoints), source=0.0_pReal)
-    allocate  (temperature    (h)%p(Nmaterialpoints), source=thermal_initialT(h))
-    deallocate(temperatureRate(h)%p)
-    allocate  (temperatureRate(h)%p(Nmaterialpoints), source=0.0_pReal)
 
     end associate
   enddo
 
+  ce = 0
+  do el = 1, discretization_Nelems
+    do ip = 1, discretization_nIPs
+      ce = ce + 1
+      ho = material_homogenizationAt(el)
+      if (thermal_type(ho) == THERMAL_conduction_ID) T(ce) = thermal_initialT(ho)
+    enddo
+  enddo
+
 end subroutine thermal_conduction_init
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief return heat generation rate
 !--------------------------------------------------------------------------------------------------
-subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
+subroutine thermal_conduction_getSource(Tdot, T,ip,el)
 
   integer, intent(in) :: &
     ip, &                                                                                           !< integration point number
@@ -94,20 +99,17 @@ subroutine thermal_conduction_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
   real(pReal), intent(in) :: &
     T
   real(pReal), intent(out) :: &
-    Tdot, dTdot_dT
+    Tdot
-  integer :: &
+
+ integer :: &
     homog
 
-  Tdot = 0.0_pReal
+  homog = material_homogenizationAt(el)
-  dTdot_dT = 0.0_pReal
+  call constitutive_thermal_getRate(TDot, T,ip,el)
-
-  homog  = material_homogenizationAt(el)
-  call constitutive_thermal_getRateAndItsTangents(TDot, dTDot_dT, T, crystallite_S,crystallite_Lp ,ip, el) 
 
   Tdot = Tdot/real(homogenization_Nconstituents(homog),pReal)
-  dTdot_dT = dTdot_dT/real(homogenization_Nconstituents(homog),pReal)
 
-end subroutine thermal_conduction_getSourceAndItsTangent
+end subroutine thermal_conduction_getSource
 
 
 !--------------------------------------------------------------------------------------------------
@@ -120,14 +122,16 @@ function thermal_conduction_getConductivity(ip,el)
     el                                                                                              !< element number
   real(pReal), dimension(3,3) :: &
     thermal_conduction_getConductivity
+
   integer :: &
-    grain
+    co
 
 
   thermal_conduction_getConductivity = 0.0_pReal
-  do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
+
+  do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
     thermal_conduction_getConductivity = thermal_conduction_getConductivity + &
-     crystallite_push33ToRef(grain,ip,el,lattice_K(:,:,material_phaseAt(grain,el)))
+     crystallite_push33ToRef(co,ip,el,lattice_K(:,:,material_phaseAt(co,el)))
   enddo
 
   thermal_conduction_getConductivity = thermal_conduction_getConductivity &
@@ -146,14 +150,16 @@ function thermal_conduction_getSpecificHeat(ip,el)
     el                                                                                              !< element number
   real(pReal) :: &
     thermal_conduction_getSpecificHeat
+
   integer :: &
-    grain
+    co
+
 
   thermal_conduction_getSpecificHeat = 0.0_pReal
 
-  do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
+  do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
     thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat &
-                                       + lattice_c_p(material_phaseAt(grain,el))
+                                       + lattice_c_p(material_phaseAt(co,el))
   enddo
 
   thermal_conduction_getSpecificHeat = thermal_conduction_getSpecificHeat &
@@ -172,15 +178,16 @@ function thermal_conduction_getMassDensity(ip,el)
     el                                                                                              !< element number
   real(pReal) :: &
     thermal_conduction_getMassDensity
+
   integer :: &
-    grain
+    co
+
 
   thermal_conduction_getMassDensity = 0.0_pReal
 
-
+  do co = 1, homogenization_Nconstituents(material_homogenizationAt(el))
-  do grain = 1, homogenization_Nconstituents(material_homogenizationAt(el))
     thermal_conduction_getMassDensity = thermal_conduction_getMassDensity &
-                                      + lattice_rho(material_phaseAt(grain,el))
+                                      + lattice_rho(material_phaseAt(co,el))
   enddo
 
   thermal_conduction_getMassDensity = thermal_conduction_getMassDensity &
@@ -205,7 +212,7 @@ subroutine thermal_conduction_putTemperatureAndItsRate(T,Tdot,ip,el)
     offset
 
   homog  = material_homogenizationAt(el)
-  offset = thermalMapping(homog)%p(ip,el)
+  offset = material_homogenizationMemberAt(ip,el)
   temperature    (homog)%p(offset) = T
   temperatureRate(homog)%p(offset) = Tdot
 

src/thermal_isothermal.f90

@@ -3,8 +3,10 @@
 !> @brief material subroutine for isothermal temperature field
 !--------------------------------------------------------------------------------------------------
 module thermal_isothermal
+  use prec
   use config
   use material
+  use discretization
 
   implicit none
   public
@@ -14,28 +16,33 @@ contains
 !--------------------------------------------------------------------------------------------------
 !> @brief allocates fields, reads information from material configuration file
 !--------------------------------------------------------------------------------------------------
-subroutine thermal_isothermal_init
+subroutine thermal_isothermal_init(T)
 
-  integer :: h,Nmaterialpoints
+  real(pReal), dimension(:), intent(inout) ::  T
+
+  integer :: Ninstances,Nmaterialpoints,ho,ip,el,ce
 
   print'(/,a)',   ' <<<+-  thermal_isothermal init  -+>>>'; flush(6)
 
-  do h = 1, size(material_name_homogenization)
+  do ho = 1, size(thermal_type)
-    if (thermal_type(h) /= THERMAL_isothermal_ID) cycle
+    if (thermal_type(ho) /= THERMAL_isothermal_ID) cycle
 
-    Nmaterialpoints = count(material_homogenizationAt == h)
+    Nmaterialpoints = count(material_homogenizationAt == ho)
-    thermalState(h)%sizeState = 0
-    allocate(thermalState(h)%state0   (0,Nmaterialpoints))
-    allocate(thermalState(h)%subState0(0,Nmaterialpoints))
-    allocate(thermalState(h)%state    (0,Nmaterialpoints))
 
-    deallocate(temperature    (h)%p)
+    allocate(temperature    (ho)%p(Nmaterialpoints),source=thermal_initialT(ho))
-    allocate  (temperature    (h)%p(1), source=thermal_initialT(h))
+    allocate(temperatureRate(ho)%p(Nmaterialpoints),source = 0.0_pReal)
-    deallocate(temperatureRate(h)%p)
-    allocate  (temperatureRate(h)%p(1))
 
   enddo
 
+  ce = 0
+  do el = 1, discretization_Nelems
+    do ip = 1, discretization_nIPs
+      ce = ce + 1
+      ho = material_homogenizationAt(el)
+      if (thermal_type(ho) == THERMAL_isothermal_ID) T(ce) = thermal_initialT(ho)
+    enddo
+  enddo
+
 end subroutine thermal_isothermal_init
 
 end module thermal_isothermal