Merge branch '134-output_none' of git.damask.mpie.de:damask/DAMASK into 134-output_none

.gitlab-ci.yml

@@ -3,20 +3,18 @@ stages:
   - prepare
   - python
   - compile
-  - setup
   - fortran
   - performance
   - deploy
-  - update_master
+  - finalize
 
 
 ###################################################################################################
 default:
   before_script:
     - ${LOCAL_HOME}/bin/queue ${CI_JOB_ID}
-    - source $DAMASKROOT/env/DAMASK.sh
+    - source env/DAMASK.sh
-    - export PATH=${TESTROOT}/bin:$PATH
+    - export PATH=${TESTROOT}/bin:${PATH}
-    - cd $DAMASKROOT/PRIVATE/testing
     - echo Job start:" $(date)"
   after_script:
     - echo Job end:" $(date)"
@@ -33,20 +31,19 @@ variables:
   # Shortcut names
   # ===============================================================================================
   TESTROOT:   "$LOCAL_HOME/GitLabCI_Pipeline_$CI_PIPELINE_ID"
-  DAMASKROOT: "$LOCAL_HOME/GitLabCI_Pipeline_$CI_PIPELINE_ID/DAMASK"
 
   # ===============================================================================================
   # Names of module files to load
   # ===============================================================================================
   # ++++++++++++ Compiler +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  IntelCompiler:  "Compiler/Intel/19.1.2 Libraries/IMKL/2020"
+  COMPILER_INTEL: "Compiler/Intel/19.1.2 Libraries/IMKL/2020"
-  GNUCompiler:    "Compiler/GNU/10"
+  COMPILER_GNU:   "Compiler/GNU/10"
   # ++++++++++++ MPI ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  MPI_Intel:      "MPI/Intel/19.1.2/IntelMPI/2019"
+  MPI_INTEL:      "MPI/Intel/19.1.2/IntelMPI/2019"
   MPI_GNU:        "MPI/GNU/10/OpenMPI/4.1.1"
   # ++++++++++++ PETSc ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  PETSc_Intel:    "Libraries/PETSc/3.16.1/Intel-19.1.2-IntelMPI-2019"
+  PETSC_INTEL:    "Libraries/PETSc/3.16.1/Intel-19.1.2-IntelMPI-2019"
-  PETSc_GNU:      "Libraries/PETSc/3.16.1/GNU-10-OpenMPI-4.1.1"
+  PETSC_GNU:      "Libraries/PETSc/3.16.1/GNU-10-OpenMPI-4.1.1"
   # ++++++++++++ MSC Marc +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   MSC:            "FEM/MSC/2021.2"
   IntelMarc:      "Compiler/Intel/19.1.2 Libraries/IMKL/2020"
@@ -54,97 +51,107 @@ variables:
 
 
 ###################################################################################################
-checkout:
+create_testroot:
   stage: prepare
   before_script:
     - ${LOCAL_HOME}/bin/queue ${CI_JOB_ID}
     - echo Job start:" $(date)"
   script:
-    - mkdir -p ${DAMASKROOT}
+    - mkdir -p ${TESTROOT}
-    - cd ${DAMASKROOT}
-    - git clone -q git@git.damask.mpie.de:damask/DAMASK.git .
-    - git checkout ${CI_COMMIT_SHA}
-    - git submodule update --init
 
 
 ###################################################################################################
 pytest:
   stage: python
   script:
-    - PYTHONPATH=${CI_PROJECT_DIR}/python
+    - cd python
-    - cd ${CI_PROJECT_DIR}/python
     - pytest --basetemp ${TESTROOT}/python -v --cov --cov-report=term
     - coverage report --fail-under=90
 
 mypy:
   stage: python
   script:
-    - cd ${CI_PROJECT_DIR}/python
+    - cd python
     - mypy damask
 
 
 ###################################################################################################
-compile_grid_Intel:
+test_grid_Intel:
   stage: compile
   script:
-    - module load $IntelCompiler $MPI_Intel $PETSc_Intel
+    - module load ${COMPILER_INTEL} ${MPI_INTEL} ${PETSC_INTEL}
-    - cd pytest
+    - cd PRIVATE/testing/pytest
     - pytest -k 'compile and grid' --basetemp ${TESTROOT}/compile_grid_Intel
 
-compile_mesh_Intel:
+test_mesh_Intel:
   stage: compile
   script:
-    - module load $IntelCompiler $MPI_Intel $PETSc_Intel
+    - module load ${COMPILER_INTEL} ${MPI_INTEL} ${PETSC_INTEL}
-    - cd pytest
+    - cd PRIVATE/testing/pytest
     - pytest -k 'compile and mesh' --basetemp ${TESTROOT}/compile_mesh_Intel
 
-compile_grid_GNU:
+test_grid_GNU:
   stage: compile
   script:
-    - module load $GNUCompiler $MPI_GNU $PETSc_GNU
+    - module load ${COMPILER_GNU} ${MPI_GNU} ${PETSC_GNU}
-    - cd pytest
+    - cd PRIVATE/testing/pytest
     - pytest -k 'compile and grid' --basetemp ${TESTROOT}/compile_grid_GNU
 
-compile_mesh_GNU:
+test_mesh_GNU:
   stage: compile
   script:
-    - module load $GNUCompiler $MPI_GNU $PETSc_GNU
+    - module load ${COMPILER_GNU} ${MPI_GNU} ${PETSC_GNU}
-    - cd pytest
+    - cd PRIVATE/testing/pytest
     - pytest -k 'compile and mesh' --basetemp ${TESTROOT}/compile_mesh_GNU
 
-compile_Marc:
+test_Marc:
   stage: compile
   script:
     - module load $IntelMarc $HDF5Marc $MSC
-    - cd pytest
+    - cd PRIVATE/testing/pytest
     - pytest -k 'compile and Marc' --basetemp ${TESTROOT}/compile_Marc
 
 
-###################################################################################################
 setup_grid:
-  stage: setup
+  stage: compile
   script:
-    - module load $IntelCompiler $MPI_Intel $PETSc_Intel
+    - module load ${COMPILER_INTEL} ${MPI_INTEL} ${PETSC_INTEL}
     - cd $(mktemp -d)
     - cmake -DDAMASK_SOLVER=GRID -DCMAKE_INSTALL_PREFIX=${TESTROOT} ${CI_PROJECT_DIR}
     - make -j2 all install
 
 setup_mesh:
-  stage: setup
+  stage: compile
   script:
-    - module load $IntelCompiler $MPI_Intel $PETSc_Intel
+    - module load ${COMPILER_INTEL} ${MPI_INTEL} ${PETSC_INTEL}
     - cd $(mktemp -d)
     - cmake -DDAMASK_SOLVER=MESH -DCMAKE_INSTALL_PREFIX=${TESTROOT} ${CI_PROJECT_DIR}
     - make -j2 all install
 
+compile_Marc:
+  stage: compile
+  script:
+    - module load $IntelMarc $HDF5Marc $MSC
+    - cd $(mktemp -d)
+    - cp ${CI_PROJECT_DIR}/examples/Marc/* .
+    - python3 -c "import damask;damask.solver.Marc().submit_job('r-value','texture',True,'h')"
+    - mkdir ${TESTROOT}/src
+    - mv ${CI_PROJECT_DIR}/src/DAMASK_Marc.marc ${TESTROOT}/src
+
 
 ###################################################################################################
-core:
+open-source:
   stage: fortran
   script:
-    - module load $IntelCompiler $MPI_Intel $PETSc_Intel
+    - module load ${COMPILER_INTEL} ${MPI_INTEL} ${PETSC_INTEL}
-    - cd pytest
+    - cd PRIVATE/testing/pytest
-    - pytest -k 'not compile' --basetemp ${TESTROOT}/fortran -v
+    - pytest -k 'not compile and not Marc' --basetemp ${TESTROOT}/open-source -v
+
+Marc:
+  stage: fortran
+  script:
+    - cd PRIVATE/testing/pytest
+    - pytest -k 'not compile and Marc' --damask-root=${TESTROOT} --basetemp ${TESTROOT}/Marc -v
 
 # Needs closer look
 # Phenopowerlaw_singleSlip:
@@ -156,20 +163,25 @@ core:
 grid_runtime:
   stage: performance
   script:
-    - module load $IntelCompiler $MPI_Intel $PETSc_Intel
+    - module load ${COMPILER_INTEL} ${MPI_INTEL} ${PETSC_INTEL}
     - cd $(mktemp -d)
-    - cmake -DOPTIMIZATION=AGGRESSIVE -DDAMASK_SOLVER=GRID -DCMAKE_INSTALL_PREFIX=${TESTROOT} ${CI_PROJECT_DIR}
+    - cmake -DOPTIMIZATION=AGGRESSIVE -DDAMASK_SOLVER=GRID -DCMAKE_INSTALL_PREFIX=./ ${CI_PROJECT_DIR}
     - make -j2 all install
+    - export PATH=${PWD}/bin:${PATH}
     - cd $(mktemp -d)
     - git clone -q git@git.damask.mpie.de:damask/performance.git .
-    - ${DAMASKROOT}/PRIVATE/testing/runtime.py --input_dir $DAMASKROOT/examples/grid --output_dir . --tag ${CI_COMMIT_SHA}
+    - >
+        ${CI_PROJECT_DIR}/PRIVATE/testing/runtime.py
+        --input_dir ${CI_PROJECT_DIR}/examples/grid
+        --output_dir ./
+        --tag ${CI_COMMIT_SHA}
     - if [ ${CI_COMMIT_BRANCH} == development ]; then git commit -am ${CI_PIPELINE_ID}_${CI_COMMIT_SHA}; git push; fi
   before_script:
     - ${LOCAL_HOME}/bin/queue ${CI_JOB_ID} --blocking
-    - source $DAMASKROOT/env/DAMASK.sh
+    - source env/DAMASK.sh
-    - export PATH=${TESTROOT}/bin:$PATH
     - echo Job start:" $(date)"
 
+
 ###################################################################################################
 source_distribution:
   stage: deploy
@@ -179,16 +191,19 @@ source_distribution:
 
 
 ###################################################################################################
-merge_into_master:
+update_revision:
-  stage: update_master
+  stage: finalize
+  before_script:
+    - ${LOCAL_HOME}/bin/queue ${CI_JOB_ID}
+    - echo Job start:" $(date)"
   script:
-    - cd ${DAMASKROOT}
+    - cd $(mktemp -d)
-    - export TESTEDREV=$(git describe)                                                              # might be detached from development branch
+    - git clone -q git@git.damask.mpie.de:damask/DAMASK.git .
-    - echo ${TESTEDREV} > python/damask/VERSION
+    - git checkout ${CI_COMMIT_SHA}
+    - export VERSION=$(git describe)
+    - echo ${VERSION} > python/damask/VERSION
     - git add python/damask/VERSION
-    - >
+    - git commit -m "[skip ci] updated version information after successful test of $VERSION"
-        git diff-index --quiet HEAD ||
-        git commit -m "[skip ci] updated version information after successful test of $TESTEDREV"
     - export UPDATEDREV=$(git describe)                                                             # tested state + 1 commit
     - git checkout master
     - git pull

examples/config/phase/mechanical/plastic/phenopowerlaw_Mg.yaml

@@ -6,12 +6,12 @@ references:
 
 output: [xi_sl, xi_tw]
 
-N_sl: [3, 3, 0, 6, 0, 6]   # basal, 1. prism, -, 1. pyr<a>, -, 2. pyr<c+a>
+N_sl: [3, 3, 0, 6, 0, 6]   # basal, prism, -, 1. pyr<a>, -, 2. pyr<c+a>
-N_tw: [6, 0, 6]   # tension, -, compression
+N_tw: [6, 0, 6]            # tension, -, compression
 
-xi_0_sl:   [10.e+6,  55.e+6, 0.,  60.e+6, 0., 60.e+6]
+xi_0_sl:   [10.e+6,  55.e+6, 0.,  60.e+6, 0.,  60.e+6]
 xi_inf_sl: [40.e+6, 135.e+6, 0., 150.e+6, 0., 150.e+6]
-xi_0_tw: [40.e+6, 0., 60.e+6]
+xi_0_tw:   [40.e+6, 0., 60.e+6]
 
 a_sl: 2.25
 dot_gamma_0_sl: 0.001
@@ -21,9 +21,18 @@ n_tw: 20
 f_sat_sl-tw: 10.0
 
 h_0_sl-sl: 500.0e+6
-h_0_tw-tw: 50.0e+6
+h_0_tw-tw:  50.0e+6
 h_0_tw-sl: 150.0e+6
-h_sl-sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
+h_sl-sl: [+1.0,  1.0,  1.0,  1.0,  1.0,  1.0, -1.0, -1.0, -1.0, -1.0,
-h_tw-tw: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
+          -1.0, -1.0,  1.0,  1.0, -1.0,  1.0,  1.0, -1.0,  1.0,  1.0,
-h_tw-sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
+          -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0,
-h_sl-tw: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
+          +1.0,  1.0, -1.0,  1.0, -1.0,  1.0,  1.0, -1.0,  1.0, -1.0,
+          +1.0,  1.0]  # unused entries are indicated by -1.0
+h_tw-tw: [+1.0,  1.0, -1.0, -1.0, -1.0, -1.0,  1.0, -1.0,  1.0,  1.0,
+          -1.0,  1.0]  # unused entries are indicated by -1.0
+h_tw-sl: [+1.0, -1.0,  1.0, -1.0,  1.0, -1.0,  1.0, -1.0, -1.0, -1.0,
+          -1.0, -1.0,  1.0, -1.0,  1.0, -1.0, -1.0, -1.0, -1.0, -1.0,
+          +1.0, -1.0,  1.0, -1.0]  # unused entries are indicated by -1.0
+h_sl-tw: [+1.0, -1.0,  1.0, -1.0,  1.0, -1.0,  1.0, -1.0, -1.0, -1.0,
+          -1.0, -1.0,  1.0, -1.0,  1.0, -1.0, -1.0, -1.0, -1.0, -1.0,
+          +1.0, -1.0,  1.0]  # unused entries are indicated by -1.0

examples/config/phase/mechanical/plastic/phenopowerlaw_Ti.yaml

@@ -8,7 +8,7 @@ references:
     https://doi.org/10.1016/j.actamat.2017.05.015
 output: [gamma_sl]
 
-N_sl: [3, 3, 0, 0, 12]   # basal, 1. prism, -, -, 2. pyr<c+a>
+N_sl: [3, 3, 0, 0, 12]   # basal, 1. prism, -, -, 1. pyr<c+a>
 n_sl: 20
 a_sl: 2.0
 dot_gamma_0_sl: 0.001
@@ -20,4 +20,6 @@ xi_inf_sl: [568.e+6, 150.e+7, 0.0, 0.0, 3420.e+6]
 # L. Wang et al. :
 # xi_0_sl:   [127.e+6, 96.e+6, 0.0, 0.0, 240.e+6]
 
-h_sl-sl: [1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]
+h_sl-sl: [+1.0,  1.0,  1.0,  1.0,  1.0,  1.0, -1.0, -1.0, -1.0, -1.0,
+          -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0,
+          +1.0,  1.0, -1.0, -1.0,  1.0,  1.0, -1.0, -1.0,  1.0,  1.0] # unused entries are indicated by -1.0

install/MarcMentat/apply_DAMASK_modifications.py

@@ -8,7 +8,7 @@ from pathlib import Path
 
 import damask
 
-def copy_and_patch(patch,orig,msc_root,editor):
+def copy_and_patch(patch,orig,marc_root,editor):
     try:
         shutil.copyfile(orig,orig.parent/patch.stem)
     except shutil.SameFileError:
@@ -17,31 +17,31 @@ def copy_and_patch(patch,orig,msc_root,editor):
     with open(orig.parent/patch.stem) as f_in:
         content = f_in.read()
     with open(orig.parent/patch.stem,'w') as f_out:
-        f_out.write(content.replace('%INSTALLDIR%',msc_root).replace('%EDITOR%',editor))
+        f_out.write(content.replace('%INSTALLDIR%',marc_root).replace('%EDITOR%',editor))
 
 
 parser = argparse.ArgumentParser(
-                  description='Apply DAMASK modification to MSC.Marc/Mentat',
+                  description='Apply DAMASK modification to MSC Marc/Mentat',
                   prog = Path(__file__).name,
                   formatter_class=argparse.ArgumentDefaultsHelpFormatter)
 
 parser.add_argument('--editor', dest='editor', metavar='string', default='vi',
-                    help='Name of the editor for MSC.Mentat (executable)')
+                    help='Name of the editor for Marc Mentat (executable)')
-parser.add_argument('--msc-root', dest='msc_root', metavar='string',
+parser.add_argument('--marc-root', dest='marc_root', metavar='string',
-                    default=damask.solver._marc._msc_root,
+                    default=damask.solver._marc._marc_root,
-                    help='MSC.Marc/Mentat root directory')
+                    help='Marc root directory')
-parser.add_argument('--msc-version', dest='msc_version', type=float, metavar='float',
+parser.add_argument('--marc-version', dest='marc_version', type=float, metavar='float',
-                    default=damask.solver._marc._msc_version,
+                    default=damask.solver._marc._marc_version,
-                    help='MSC.Marc/Mentat version')
+                    help='Marc version')
 parser.add_argument('--damask-root', dest='damask_root', metavar = 'string',
                     default=damask.solver._marc._damask_root,
                     help='DAMASK root directory')
 
 args = parser.parse_args()
-msc_root    = Path(args.msc_root).expanduser()
+marc_root = Path(args.marc_root).expanduser()
 damask_root = Path(args.damask_root).expanduser()
-msc_version = int(args.msc_version) if str(args.msc_version).split('.')[1] == '0' else \
+marc_version = int(args.marc_version) if str(args.marc_version).split('.')[1] == '0' else \
-              args.msc_version
+               args.marc_version
 
 matches = {'Marc_tools':  [['comp_user','comp_damask_*mp'],
                            ['run_marc','run_damask_*mp'],
@@ -54,15 +54,15 @@ matches = {'Marc_tools':  [['comp_user','comp_damask_*mp'],
 
 print('patching files...\n')
 
-for directory in glob.glob(str(damask_root/f'install/MarcMentat/{msc_version}/*')):
+for directory in glob.glob(str(damask_root/f'install/MarcMentat/{marc_version}/*')):
     for orig, mods in matches[Path(directory).name]:
-        product,subfolder = (msc_root/Path(directory)).name.split('_')
+        product,subfolder = (marc_root/Path(directory)).name.split('_')
-        orig = msc_root/f'{product.lower()}{msc_version}/{subfolder}/{orig}'
+        orig = marc_root/f'{product.lower()}{marc_version}/{subfolder}/{orig}'
         for patch in glob.glob(f'{directory}/{mods}.patch'):
-            copy_and_patch(Path(patch),orig,msc_root,args.editor)
+            copy_and_patch(Path(patch),orig,marc_root,args.editor)
 
 print('compiling Mentat menu binaries...')
 
-executable = msc_root/f'mentat{msc_version}/bin/mentat'
+executable = marc_root/f'mentat{marc_version}/bin/mentat'
-menu_file  = msc_root/f'mentat{msc_version}/menus/linux64/main.msb'
+menu_file  = marc_root/f'mentat{marc_version}/menus/linux64/main.msb'
 os.system(f'xvfb-run -a {executable} -compile {menu_file}')

python/damask/VERSION

@@ -1 +1 @@
-v3.0.0-alpha5-90-gbb6655045
+v3.0.0-alpha5-191-gf32a78861

python/damask/_colormap.py

@@ -2,6 +2,8 @@ import os
 import json
 import functools
 import colorsys
+from pathlib import Path
+from typing import Sequence, Union, TextIO
 
 import numpy as np
 import matplotlib as mpl
@@ -14,9 +16,9 @@ from PIL import Image
 from . import util
 from . import Table
 
-_eps   = 216./24389.
+_EPS   = 216./24389.
-_kappa = 24389./27.
+_KAPPA = 24389./27.
-_ref_white = np.array([.95047, 1.00000, 1.08883])                                                   # Observer = 2, Illuminant = D65
+_REF_WHITE = np.array([.95047, 1.00000, 1.08883])                                                   # Observer = 2, Illuminant = D65
 
 # ToDo (if needed)
 # - support alpha channel (paraview/ASCII/input)
@@ -39,20 +41,20 @@ class Colormap(mpl.colors.ListedColormap):
 
     """
 
-    def __add__(self,other):
+    def __add__(self, other: "Colormap") -> "Colormap":
         """Concatenate."""
         return Colormap(np.vstack((self.colors,other.colors)),
                         f'{self.name}+{other.name}')
 
-    def __iadd__(self,other):
+    def __iadd__(self, other: "Colormap") -> "Colormap":
         """Concatenate (in-place)."""
         return self.__add__(other)
 
-    def __invert__(self):
+    def __invert__(self) -> "Colormap":
         """Reverse."""
         return self.reversed()
 
-    def __repr__(self):
+    def __repr__(self) -> str:
         """Show as matplotlib figure."""
         fig = plt.figure(self.name,figsize=(5,.5))
         ax1 = fig.add_axes([0, 0, 1, 1])
@@ -64,7 +66,11 @@ class Colormap(mpl.colors.ListedColormap):
 
 
     @staticmethod
-    def from_range(low,high,name='DAMASK colormap',N=256,model='rgb'):
+    def from_range(low: Sequence[float],
+                   high: Sequence[float],
+                   name: str = 'DAMASK colormap',
+                   N: int = 256,
+                   model: str = 'rgb') -> "Colormap":
         """
         Create a perceptually uniform colormap between given (inclusive) bounds.
 
@@ -145,7 +151,7 @@ class Colormap(mpl.colors.ListedColormap):
 
 
     @staticmethod
-    def from_predefined(name,N=256):
+    def from_predefined(name: str, N: int = 256) -> "Colormap":
         """
         Select from a set of predefined colormaps.
 
@@ -185,7 +191,10 @@ class Colormap(mpl.colors.ListedColormap):
             return Colormap.from_range(definition['low'],definition['high'],name,N)
 
 
-    def shade(self,field,bounds=None,gap=None):
+    def shade(self,
+              field: np.ndarray,
+              bounds: Sequence[float] = None,
+              gap: float = None) -> Image:
         """
         Generate PIL image of 2D field using colormap.
 
@@ -226,7 +235,7 @@ class Colormap(mpl.colors.ListedColormap):
             mode='RGBA')
 
 
-    def reversed(self,name=None):
+    def reversed(self, name: str = None) -> "Colormap":
         """
         Reverse.
 
@@ -251,7 +260,7 @@ class Colormap(mpl.colors.ListedColormap):
         return Colormap(np.array(rev.colors),rev.name[:-4] if rev.name.endswith('_r_r') else rev.name)
 
 
-    def _get_file_handle(self,fname,extension):
+    def _get_file_handle(self, fname: Union[TextIO, str, Path, None], suffix: str) -> TextIO:
         """
         Provide file handle.
 
@@ -259,8 +268,7 @@ class Colormap(mpl.colors.ListedColormap):
         ----------
         fname : file, str, pathlib.Path, or None
             Filename or filehandle, will be name of the colormap+extension if None.
-
+        suffix: str
-        extension: str
             Extension of the filename.
 
         Returns
@@ -270,17 +278,14 @@ class Colormap(mpl.colors.ListedColormap):
 
         """
         if fname is None:
-            fhandle = open(self.name.replace(' ','_')+'.'+extension,'w',newline='\n')
+            return open(self.name.replace(' ','_')+suffix, 'w', newline='\n')
+        elif isinstance(fname, (str, Path)):
+            return open(fname, 'w', newline='\n')
         else:
-            try:
+            return fname
-                fhandle = open(fname,'w',newline='\n')
-            except TypeError:
-                fhandle = fname
-
-        return fhandle
 
 
-    def save_paraview(self,fname=None):
+    def save_paraview(self, fname: Union[TextIO, str, Path] = None):
         """
         Save as JSON file for use in Paraview.
 
@@ -303,10 +308,10 @@ class Colormap(mpl.colors.ListedColormap):
                 'RGBPoints':colors
                }]
 
-        json.dump(out,self._get_file_handle(fname,'json'),indent=4)
+        json.dump(out,self._get_file_handle(fname,'.json'),indent=4)
 
 
-    def save_ASCII(self,fname=None):
+    def save_ASCII(self, fname: Union[TextIO, str, Path] = None):
         """
         Save as ASCII file.
 
@@ -319,10 +324,10 @@ class Colormap(mpl.colors.ListedColormap):
         """
         labels = {'RGBA':4} if self.colors.shape[1] == 4 else {'RGB': 3}
         t = Table(self.colors,labels,f'Creator: {util.execution_stamp("Colormap")}')
-        t.save(self._get_file_handle(fname,'txt'))
+        t.save(self._get_file_handle(fname,'.txt'))
 
 
-    def save_GOM(self,fname=None):
+    def save_GOM(self, fname: Union[TextIO, str, Path] = None):
         """
         Save as ASCII file for use in GOM Aramis.
 
@@ -340,10 +345,10 @@ class Colormap(mpl.colors.ListedColormap):
                 + ' '.join([f' 0 {c[0]} {c[1]} {c[2]} 255 1' for c in reversed((self.colors*255).astype(int))]) \
                 + '\n'
 
-        self._get_file_handle(fname,'legend').write(GOM_str)
+        self._get_file_handle(fname,'.legend').write(GOM_str)
 
 
-    def save_gmsh(self,fname=None):
+    def save_gmsh(self, fname: Union[TextIO, str, Path] = None):
         """
         Save as ASCII file for use in gmsh.
 
@@ -358,11 +363,13 @@ class Colormap(mpl.colors.ListedColormap):
         gmsh_str = 'View.ColorTable = {\n' \
                  +'\n'.join([f'{c[0]},{c[1]},{c[2]},' for c in self.colors[:,:3]*255]) \
                  +'\n}\n'
-        self._get_file_handle(fname,'msh').write(gmsh_str)
+        self._get_file_handle(fname,'.msh').write(gmsh_str)
 
 
     @staticmethod
-    def _interpolate_msh(frac,low,high):
+    def _interpolate_msh(frac,
+                         low: np.ndarray,
+                         high: np.ndarray) -> np.ndarray:
         """
         Interpolate in Msh color space.
 
@@ -439,31 +446,31 @@ class Colormap(mpl.colors.ListedColormap):
 
 
     @staticmethod
-    def _hsv2rgb(hsv):
+    def _hsv2rgb(hsv: np.ndarray) -> np.ndarray:
         """H(ue) S(aturation) V(alue) to R(red) G(reen) B(lue)."""
         return np.array(colorsys.hsv_to_rgb(hsv[0]/360.,hsv[1],hsv[2]))
 
     @staticmethod
-    def _rgb2hsv(rgb):
+    def _rgb2hsv(rgb: np.ndarray) -> np.ndarray:
         """R(ed) G(reen) B(lue) to H(ue) S(aturation) V(alue)."""
         h,s,v = colorsys.rgb_to_hsv(rgb[0],rgb[1],rgb[2])
         return np.array([h*360,s,v])
 
 
     @staticmethod
-    def _hsl2rgb(hsl):
+    def _hsl2rgb(hsl: np.ndarray) -> np.ndarray:
         """H(ue) S(aturation) L(uminance) to R(red) G(reen) B(lue)."""
         return np.array(colorsys.hls_to_rgb(hsl[0]/360.,hsl[2],hsl[1]))
 
     @staticmethod
-    def _rgb2hsl(rgb):
+    def _rgb2hsl(rgb: np.ndarray) -> np.ndarray:
         """R(ed) G(reen) B(lue) to H(ue) S(aturation) L(uminance)."""
         h,l,s = colorsys.rgb_to_hls(rgb[0],rgb[1],rgb[2])
         return np.array([h*360,s,l])
 
 
     @staticmethod
-    def _xyz2rgb(xyz):
+    def _xyz2rgb(xyz: np.ndarray) -> np.ndarray:
         """
         CIE Xyz to R(ed) G(reen) B(lue).
 
@@ -483,7 +490,7 @@ class Colormap(mpl.colors.ListedColormap):
         return np.clip(rgb,0.,1.)
 
     @staticmethod
-    def _rgb2xyz(rgb):
+    def _rgb2xyz(rgb: np.ndarray) -> np.ndarray:
         """
         R(ed) G(reen) B(lue) to CIE Xyz.
 
@@ -501,7 +508,7 @@ class Colormap(mpl.colors.ListedColormap):
 
 
     @staticmethod
-    def _lab2xyz(lab,ref_white=None):
+    def _lab2xyz(lab: np.ndarray, ref_white: np.ndarray = None) -> np.ndarray:
         """
         CIE Lab to CIE Xyz.
 
@@ -514,13 +521,13 @@ class Colormap(mpl.colors.ListedColormap):
         f_z = (lab[0]+16.)/116. - lab[2]/200.
 
         return np.array([
-                         f_x**3.                if f_x**3. > _eps     else (116.*f_x-16.)/_kappa,
+                         f_x**3.                if f_x**3. > _EPS     else (116.*f_x-16.)/_KAPPA,
-                         ((lab[0]+16.)/116.)**3 if lab[0]>_kappa*_eps else lab[0]/_kappa,
+                         ((lab[0]+16.)/116.)**3 if lab[0]>_KAPPA*_EPS else lab[0]/_KAPPA,
-                         f_z**3.                if f_z**3. > _eps     else (116.*f_z-16.)/_kappa
+                         f_z**3.                if f_z**3. > _EPS     else (116.*f_z-16.)/_KAPPA
-                        ])*(ref_white if ref_white is not None else _ref_white)
+                        ])*(ref_white if ref_white is not None else _REF_WHITE)
 
     @staticmethod
-    def _xyz2lab(xyz,ref_white=None):
+    def _xyz2lab(xyz: np.ndarray, ref_white: np.ndarray = None) -> np.ndarray:
         """
         CIE Xyz to CIE Lab.
 
@@ -529,8 +536,8 @@ class Colormap(mpl.colors.ListedColormap):
         http://www.brucelindbloom.com/index.html?Eqn_Lab_to_XYZ.html
 
         """
-        ref_white = ref_white if ref_white is not None else _ref_white
+        ref_white = ref_white if ref_white is not None else _REF_WHITE
-        f = np.where(xyz/ref_white > _eps,(xyz/ref_white)**(1./3.),(_kappa*xyz/ref_white+16.)/116.)
+        f = np.where(xyz/ref_white > _EPS,(xyz/ref_white)**(1./3.),(_KAPPA*xyz/ref_white+16.)/116.)
 
         return np.array([
                          116.0 *  f[1] - 16.0,
@@ -540,7 +547,7 @@ class Colormap(mpl.colors.ListedColormap):
 
 
     @staticmethod
-    def _lab2msh(lab):
+    def _lab2msh(lab: np.ndarray) -> np.ndarray:
         """
         CIE Lab to Msh.
 
@@ -558,7 +565,7 @@ class Colormap(mpl.colors.ListedColormap):
                         ])
 
     @staticmethod
-    def _msh2lab(msh):
+    def _msh2lab(msh: np.ndarray) -> np.ndarray:
         """
         Msh to CIE Lab.
 
@@ -575,29 +582,29 @@ class Colormap(mpl.colors.ListedColormap):
                         ])
 
     @staticmethod
-    def _lab2rgb(lab):
+    def _lab2rgb(lab: np.ndarray) -> np.ndarray:
         return Colormap._xyz2rgb(Colormap._lab2xyz(lab))
 
     @staticmethod
-    def _rgb2lab(rgb):
+    def _rgb2lab(rgb: np.ndarray) -> np.ndarray:
         return Colormap._xyz2lab(Colormap._rgb2xyz(rgb))
 
     @staticmethod
-    def _msh2rgb(msh):
+    def _msh2rgb(msh: np.ndarray) -> np.ndarray:
         return Colormap._lab2rgb(Colormap._msh2lab(msh))
 
     @staticmethod
-    def _rgb2msh(rgb):
+    def _rgb2msh(rgb: np.ndarray) -> np.ndarray:
         return Colormap._lab2msh(Colormap._rgb2lab(rgb))
 
     @staticmethod
-    def _hsv2msh(hsv):
+    def _hsv2msh(hsv: np.ndarray) -> np.ndarray:
         return Colormap._rgb2msh(Colormap._hsv2rgb(hsv))
 
     @staticmethod
-    def _hsl2msh(hsl):
+    def _hsl2msh(hsl: np.ndarray) -> np.ndarray:
         return Colormap._rgb2msh(Colormap._hsl2rgb(hsl))
 
     @staticmethod
-    def _xyz2msh(xyz):
+    def _xyz2msh(xyz: np.ndarray) -> np.ndarray:
         return Colormap._lab2msh(Colormap._xyz2lab(xyz))

python/damask/_configmaterial.py

@@ -440,9 +440,10 @@ class ConfigMaterial(Config):
         """
         N,n,shaped = 1,1,{}
 
+        map_dim = {'O':-1,'F_i':-2}
         for k,v in kwargs.items():
             shaped[k] = np.array(v)
-            s = shaped[k].shape[:-1] if k=='O' else shaped[k].shape
+            s = shaped[k].shape[:map_dim.get(k,None)]
             N = max(N,s[0]) if len(s)>0 else N
             n = max(n,s[1]) if len(s)>1 else n
 
@@ -451,11 +452,12 @@ class ConfigMaterial(Config):
         if 'v' not in kwargs:
             shaped['v'] = np.broadcast_to(1/n,(N,n))
 
+        map_shape = {'O':(N,n,4),'F_i':(N,n,3,3)}
         for k,v in shaped.items():
-            target = (N,n,4) if k=='O' else (N,n)
+            target = map_shape.get(k,(N,n))
             obj = np.broadcast_to(v.reshape(util.shapeshifter(v.shape,target,mode='right')),target)
             for i in range(N):
-                if k in ['phase','O','v']:
+                if k in ['phase','O','v','F_i']:
                     for j in range(n):
                         mat[i]['constituents'][j][k] = obj[i,j].item() if isinstance(obj[i,j],np.generic) else obj[i,j]
                 else:

python/damask/_grid.py

@@ -54,9 +54,9 @@ class Grid:
         mat_max = np.nanmax(self.material)
         mat_N   = self.N_materials
         return util.srepr([
-               f'cells  a b c: {util.srepr(self.cells, " x ")}',
+               f'cells : {util.srepr(self.cells, " x ")}',
-               f'size   x y z: {util.srepr(self.size,  " x ")}',
+               f'size  : {util.srepr(self.size,  " x ")} / m³',
-               f'origin x y z: {util.srepr(self.origin,"   ")}',
+               f'origin: {util.srepr(self.origin,"   ")} / m',
                f'# materials: {mat_N}' + ('' if mat_min == 0 and mat_max+1 == mat_N else
                                           f' (min: {mat_min}, max: {mat_max})')
               ])

python/damask/solver/_marc.py

@@ -3,14 +3,14 @@ import shlex
 import re
 from pathlib import Path
 
-_msc_version = 2021.2
+_marc_version = 2021.2
-_msc_root = '/opt/msc'
+_marc_root = '/opt/msc'
 _damask_root = str(Path(__file__).parents[3])
 
 class Marc:
-    """Wrapper to run DAMASK with MSC.Marc."""
+    """Wrapper to run DAMASK with MSC Marc."""
 
-    def __init__(self,msc_version=_msc_version,msc_root=_msc_root,damask_root=_damask_root):
+    def __init__(self,marc_version=_marc_version,marc_root=_marc_root,damask_root=_damask_root):
         """
         Create a Marc solver object.
 
@@ -20,14 +20,14 @@ class Marc:
             Marc version
 
         """
-        self.msc_version = msc_version
+        self.marc_version = marc_version
-        self.msc_root    = Path(msc_root)
+        self.marc_root    = Path(marc_root)
         self.damask_root = Path(damask_root)
 
     @property
     def library_path(self):
 
-        path_lib = self.msc_root/f'mentat{self.msc_version}/shlib/linux64'
+        path_lib = self.marc_root/f'mentat{self.marc_version}/shlib/linux64'
         if not path_lib.is_dir():
             raise FileNotFoundError(f'library path "{path_lib}" not found')
 
@@ -37,7 +37,7 @@ class Marc:
     @property
     def tools_path(self):
 
-        path_tools = self.msc_root/f'marc{self.msc_version}/tools'
+        path_tools = self.marc_root/f'marc{self.marc_version}/tools'
         if not path_tools.is_dir():
             raise FileNotFoundError(f'tools path "{path_tools}" not found')
 

python/tests/conftest.py

@@ -49,9 +49,8 @@ def patch_plt_show(monkeypatch):
 
 
 def pytest_addoption(parser):
-    parser.addoption("--update",
+    parser.addoption('--update', action='store_true', default=False,
-                     action="store_true",
+                     help='Update reference results.')
-                     default=False)
 
 
 @pytest.fixture

python/tests/test_Colormap.py

@@ -77,6 +77,12 @@ class TestColormap:
             # xyz2msh
             assert np.allclose(Colormap._xyz2msh(xyz),msh,atol=1.e-6,rtol=0)
 
+    @pytest.mark.parametrize('low,high',[((0,0,0),(1,1,1)),
+                                         ([0,0,0],[1,1,1])])
+    def test_from_range_types(self,low,high):
+        a = Colormap.from_range(low,high)
+        b = Colormap.from_range(np.array(low),np.array(high))
+        assert np.all(a.colors == b.colors) 
 
     @pytest.mark.parametrize('format',['ASCII','paraview','GOM','gmsh'])
     @pytest.mark.parametrize('model',['rgb','hsv','hsl','xyz','lab','msh'])

python/tests/test_ConfigMaterial.py

@@ -99,12 +99,15 @@ class TestConfigMaterial:
     @pytest.mark.parametrize('N,n,kw',[
                                         (1,1,{'phase':'Gold',
                                               'O':[1,0,0,0],
+                                              'F_i':np.eye(3),
                                               'homogenization':'SX'}),
                                         (3,1,{'phase':'Gold',
                                               'O':Rotation.from_random(3),
+                                              'F_i':np.broadcast_to(np.eye(3),(3,3,3)),
                                               'homogenization':'SX'}),
                                         (2,3,{'phase':np.broadcast_to(['a','b','c'],(2,3)),
                                               'O':Rotation.from_random((2,3)),
+                                              'F_i':np.broadcast_to(np.eye(3),(2,3,3,3)),
                                               'homogenization':['SX','PX']}),
                                         ])
     def test_material_add(self,kw,N,n):

python/tests/test_Rotation.py

@@ -989,11 +989,19 @@ class TestRotation:
         with pytest.raises(TypeError):
             R@data
 
-    def test_misorientation(self):
+    def test_misorientation_invariant(self):
         R = Rotation.from_random()
         assert np.allclose(R.misorientation(R).as_matrix(),np.eye(3))
 
-    def test_misorientation360(self):
+    def test_misorientation_average(self):
+        """2 times the average is the misorientation."""
+        r = Rotation.from_random(2)
+        a = r[0].misorientation(r[1]).as_axis_angle()
+        b = r.average().misorientation(r[1]).as_axis_angle()
+        b[3] = (b[3]*2)%np.pi
+        assert np.allclose(a,b)
+
+    def test_misorientation_360deg(self):
         R_1 = Rotation()
         R_2 = Rotation.from_Euler_angles([360,0,0],degrees=True)
         assert np.allclose(R_1.misorientation(R_2).as_matrix(),np.eye(3))

src/CPFEM.f90

@@ -103,7 +103,7 @@ subroutine CPFEM_init
   class(tNode), pointer :: &
     debug_CPFEM
 
-  print'(/,a)', ' <<<+-  CPFEM init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  CPFEM init  -+>>>'; flush(IO_STDOUT)
 
   allocate(CPFEM_cs(               6,discretization_nIPs,discretization_Nelems), source= 0.0_pReal)
   allocate(CPFEM_dcsdE(          6,6,discretization_nIPs,discretization_Nelems), source= 0.0_pReal)

src/CPFEM2.f90

@@ -81,7 +81,7 @@ subroutine CPFEM_init
   integer(HID_T) :: fileHandle
 
 
-  print'(/,a)', ' <<<+-  CPFEM init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  CPFEM init  -+>>>'; flush(IO_STDOUT)
 
 
   if (interface_restartInc > 0) then

src/DAMASK_Marc.f90

@@ -46,7 +46,7 @@ subroutine DAMASK_interface_init
   integer                 :: ierr
   character(len=pPathLen) :: wd
 
-  print'(/,a)', ' <<<+-  DAMASK_marc init -+>>>'
+  print'(/,1x,a)', '<<<+-  DAMASK_marc init -+>>>'
 
   print*, 'Roters et al., Computational Materials Science 158:420–478, 2019'
   print*, 'https://doi.org/10.1016/j.commatsci.2018.04.030'

src/DAMASK_interface.f90

@@ -70,7 +70,7 @@ subroutine DAMASK_interface_init
   external :: &
     quit
 
-  print'(/,a)', ' <<<+-  DAMASK_interface init  -+>>>'
+  print'(/,1x,a)', '<<<+-  DAMASK_interface init  -+>>>'
 
   if(worldrank == 0) open(OUTPUT_UNIT, encoding='UTF-8')                                            ! for special characters in output
 

src/HDF5_utilities.f90

@@ -109,7 +109,7 @@ subroutine HDF5_utilities_init
   integer(SIZE_T) :: typeSize
 
 
-  print'(/,a)', ' <<<+-  HDF5_Utilities init  -+>>>'
+  print'(/,1x,a)', '<<<+-  HDF5_Utilities init  -+>>>'
 
 
   call h5open_f(hdferr)

src/IO.f90

@@ -56,7 +56,7 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine IO_init
 
-  print'(/,a)', ' <<<+-  IO init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  IO init  -+>>>'; flush(IO_STDOUT)
 
   call selfTest
 

src/YAML_types.f90

@@ -187,7 +187,7 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine YAML_types_init
 
-  print'(/,a)', ' <<<+-  YAML_types init  -+>>>'
+  print'(/,1x,a)', '<<<+-  YAML_types init  -+>>>'
 
   call selfTest
 

src/base64.f90

@@ -27,7 +27,7 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine base64_init
 
-  print'(/,a)', ' <<<+-  base64 init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  base64 init  -+>>>'; flush(IO_STDOUT)
 
   call selfTest
 

src/commercialFEM_fileList.f90

@@ -4,6 +4,7 @@
 !> @details List of files needed by MSC.Marc
 !--------------------------------------------------------------------------------------------------
 #include "parallelization.f90"
+#include "constants.f90"
 #include "IO.f90"
 #include "YAML_types.f90"
 #include "YAML_parse.f90"

src/config.f90

@@ -30,8 +30,7 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine config_init
 
-  print'(/,a)', ' <<<+-  config init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  config init  -+>>>'; flush(IO_STDOUT)
-
 
   call parse_material
   call parse_numerics
@@ -50,15 +49,15 @@ subroutine parse_material()
 
 
   inquire(file='material.yaml',exist=fileExists)
-  if(.not. fileExists) call IO_error(100,ext_msg='material.yaml')
+  if (.not. fileExists) call IO_error(100,ext_msg='material.yaml')
 
   if (worldrank == 0) then
-    print*, 'reading material.yaml'; flush(IO_STDOUT)
+    print'(/,1x,a)', 'reading material.yaml'; flush(IO_STDOUT)
     fileContent = IO_read('material.yaml')
     call results_openJobFile(parallel=.false.)
     call results_writeDataset_str(fileContent,'setup','material.yaml','main configuration')
     call results_closeJobFile
-  endif
+  end if
   call parallelization_bcast_str(fileContent)
 
   config_material => YAML_parse_str(fileContent)
@@ -81,19 +80,19 @@ subroutine parse_numerics()
   if (fileExists) then
 
     if (worldrank == 0) then
-      print*, 'reading numerics.yaml'; flush(IO_STDOUT)
+      print'(1x,a)', 'reading numerics.yaml'; flush(IO_STDOUT)
       fileContent = IO_read('numerics.yaml')
       if (len(fileContent) > 0) then
         call results_openJobFile(parallel=.false.)
         call results_writeDataset_str(fileContent,'setup','numerics.yaml','numerics configuration')
         call results_closeJobFile
-      endif
+      end if
-    endif
+    end if
     call parallelization_bcast_str(fileContent)
 
     config_numerics => YAML_parse_str(fileContent)
 
-  endif
+  end if
 
 end subroutine parse_numerics
 
@@ -113,19 +112,19 @@ subroutine parse_debug()
   if (fileExists) then
 
     if (worldrank == 0) then
-      print*, 'reading debug.yaml'; flush(IO_STDOUT)
+      print'(1x,a)', 'reading debug.yaml'; flush(IO_STDOUT)
       fileContent = IO_read('debug.yaml')
       if (len(fileContent) > 0) then
         call results_openJobFile(parallel=.false.)
         call results_writeDataset_str(fileContent,'setup','debug.yaml','debug configuration')
         call results_closeJobFile
-      endif
+      end if
-    endif
+    end if
     call parallelization_bcast_str(fileContent)
 
     config_debug => YAML_parse_str(fileContent)
 
-  endif
+  end if
 
 end subroutine parse_debug
 

src/constants.f90

@@ -0,0 +1,15 @@
+!--------------------------------------------------------------------------------------------------
+!> @author Martin Diehl, KU Leuven
+!> @brief  physical constants
+!--------------------------------------------------------------------------------------------------
+module constants
+  use prec
+
+  implicit none
+  public
+
+  real(pReal), parameter :: &
+    T_ROOM = 300.0_pReal, &                                                                         !< Room temperature in K
+    K_B = 1.38e-23_pReal                                                                             !< Boltzmann constant in J/Kelvin
+
+end module constants

src/discretization.f90

@@ -49,7 +49,7 @@ subroutine discretization_init(materialAt,&
   integer, optional,           intent(in) :: &
     sharedNodesBegin                                                                                !< index of first node shared among different processes (MPI)
 
-  print'(/,a)', ' <<<+-  discretization init  -+>>>'; flush(6)
+  print'(/,1x,a)', '<<<+-  discretization init  -+>>>'; flush(6)
 
   discretization_Nelems = size(materialAt,1)
   discretization_nIPs   = size(IPcoords0,2)/discretization_Nelems

src/element.f90

@@ -923,7 +923,7 @@ subroutine tElement_init(self,elemType)
 
   self%nIPneighbors = size(self%IPneighbor,1)
 
-  print'(/,a)', ' <<<+-  element_init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  element_init  -+>>>'; flush(IO_STDOUT)
 
   print*, 'element type:      ',self%elemType
   print*, '  geom type:       ',self%geomType

src/grid/DAMASK_grid.f90

@@ -113,10 +113,10 @@ program DAMASK_grid
 ! init DAMASK (all modules)
 
   call CPFEM_initAll
-  print'(/,a)',   ' <<<+-  DAMASK_grid init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  DAMASK_grid init  -+>>>'; flush(IO_STDOUT)
 
-  print*, 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
+  print'(/,1x,a)', 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
-  print*, 'https://doi.org/10.1007/978-981-10-6855-3_80'
+  print'(  1x,a)', 'https://doi.org/10.1007/978-981-10-6855-3_80'
 
 
 !-------------------------------------------------------------------------------------------------
@@ -223,21 +223,21 @@ program DAMASK_grid
     loadCases(l)%r         = step_discretization%get_asFloat('r',         defaultVal= 1.0_pReal)
 
     loadCases(l)%f_restart = load_step%get_asInt('f_restart', defaultVal=huge(0))
-    if (load_step%get_asString('f_out',defaultVal='DAMASK') == 'none') then
+    if (load_step%get_asString('f_out',defaultVal='n/a') == 'none') then
-       loadCases(l)%f_out = huge(0)
+      loadCases(l)%f_out = huge(0)
     else
-      loadCases(l)%f_out     = load_step%get_asInt('f_out', defaultVal=1)
+      loadCases(l)%f_out = load_step%get_asInt('f_out', defaultVal=1)
-    endif
+    end if
     loadCases(l)%estimate_rate = (load_step%get_asBool('estimate_rate',defaultVal=.true.) .and. l>1)
 
     reportAndCheck: if (worldrank == 0) then
-      print'(/,a,i0)', ' load case: ', l
+      print'(/,1x,a,1x,i0)', 'load case:', l
-      print*, ' estimate_rate:', loadCases(l)%estimate_rate
+      print'(2x,a,1x,l1)', 'estimate_rate:', loadCases(l)%estimate_rate
       if (loadCases(l)%deformation%myType == 'F') then
-        print*, ' F:'
+        print'(2x,a)', 'F:'
       else
-        print*, ' '//loadCases(l)%deformation%myType//' / 1/s:'
+        print'(2x,a)', loadCases(l)%deformation%myType//' / 1/s:'
-      endif
+      end if
       do i = 1, 3; do j = 1, 3
         if (loadCases(l)%deformation%mask(i,j)) then
           write(IO_STDOUT,'(2x,12a)',advance='no') '     x      '
@@ -250,8 +250,8 @@ program DAMASK_grid
       if (any(.not.(loadCases(l)%stress%mask .or. 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 == 'P')     print'(2x,a)', 'P / MPa:'
-      if (loadCases(l)%stress%myType == 'dot_P') print*, ' dot_P / MPa/s:'
+      if (loadCases(l)%stress%myType == 'dot_P') print'(2x,a)', 'dot_P / MPa/s:'
 
       if (loadCases(l)%stress%myType /= '') then
         do i = 1, 3; do j = 1, 3
@@ -274,16 +274,16 @@ program DAMASK_grid
       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 width)'
+        print'(2x,a)', 'r: 1 (constant step width)'
       else
-        print'(a,f0.3)', '  r: ', loadCases(l)%r
+        print'(2x,a,1x,f0.3)', 'r:', loadCases(l)%r
       endif
-      print'(a,f0.3)',   '  t: ', loadCases(l)%t
+      print'(2x,a,1x,f0.3)',   't:', loadCases(l)%t
-      print'(a,i0)',     '  N: ', loadCases(l)%N
+      print'(2x,a,1x,i0)',     'N:', loadCases(l)%N
       if (loadCases(l)%f_out < huge(0)) &
-        print'(a,i0)',   '  f_out: ', loadCases(l)%f_out
+        print'(2x,a,1x,i0)',   'f_out:', loadCases(l)%f_out
       if (loadCases(l)%f_restart < huge(0)) &
-        print'(a,i0)',   '  f_restart: ', loadCases(l)%f_restart
+        print'(2x,a,1x,i0)',   'f_restart:', loadCases(l)%f_restart
 
       if (errorID > 0) call IO_error(error_ID = errorID, el = l)
 
@@ -322,7 +322,7 @@ program DAMASK_grid
   endif
 
   writeUndeformed: if (interface_restartInc < 1) then
-    print'(/,a)', ' ... writing initial configuration to file ........................'
+    print'(/,1x,a)', '... writing initial configuration to file .................................'
     flush(IO_STDOUT)
     call CPFEM_results(0,0.0_pReal)
   endif writeUndeformed
@@ -358,8 +358,8 @@ program DAMASK_grid
 
 !--------------------------------------------------------------------------------------------------
 ! report begin of new step
-          print'(/,a)', ' ###########################################################################'
+          print'(/,1x,a)', '###########################################################################'
-          print'(1x,a,es12.5,6(a,i0))', &
+          print'(1x,a,1x,es12.5,6(a,i0))', &
                   'Time', t, &
                   's: Increment ', inc,'/',loadCases(l)%N,&
                   '-', stepFraction,'/',subStepFactor**cutBackLevel,&
@@ -384,7 +384,7 @@ program DAMASK_grid
               case(FIELD_DAMAGE_ID);  call grid_damage_spectral_forward(cutBack)
             end select
           enddo
-          if(.not. cutBack) call CPFEM_forward
+          if (.not. cutBack) call CPFEM_forward
 
 !--------------------------------------------------------------------------------------------------
 ! solve fields
@@ -430,7 +430,7 @@ program DAMASK_grid
             cutBackLevel = cutBackLevel + 1
             t = t - Delta_t
             Delta_t = Delta_t/real(subStepFactor,pReal)                                             ! cut timestep
-            print'(/,a)', ' cutting back '
+            print'(/,1x,a)', 'cutting back '
           else                                                                                      ! no more options to continue
             if (worldrank == 0) close(statUnit)
             call IO_error(950)
@@ -441,26 +441,26 @@ program DAMASK_grid
         cutBackLevel = max(0, cutBackLevel - 1)                                                     ! try half number of subincs next inc
 
         if (all(solres(:)%converged)) then
-          print'(/,a,i0,a)', ' increment ', totalIncsCounter, ' converged'
+          print'(/,1x,a,i0,a)', 'increment ', totalIncsCounter, ' converged'
         else
-          print'(/,a,i0,a)', ' increment ', totalIncsCounter, ' NOT converged'
+          print'(/,1x,a,i0,a)', 'increment ', totalIncsCounter, ' NOT converged'
         endif; flush(IO_STDOUT)
 
         call MPI_Allreduce(interface_SIGUSR1,signal,1,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,ierr)
         if (ierr /= 0) error stop 'MPI error'
         if (mod(inc,loadCases(l)%f_out) == 0 .or. signal) then
-          print'(1/,a)', ' ... writing results to file ......................................'
+          print'(/,1x,a)', '... writing results to file ...............................................'
           flush(IO_STDOUT)
           call CPFEM_results(totalIncsCounter,t)
         endif
-        if(signal) call interface_setSIGUSR1(.false.)
+        if (signal) call interface_setSIGUSR1(.false.)
         call MPI_Allreduce(interface_SIGUSR2,signal,1,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,ierr)
         if (ierr /= 0) error stop 'MPI error'
         if (mod(inc,loadCases(l)%f_restart) == 0 .or. signal) then
           call mechanical_restartWrite
           call CPFEM_restartWrite
         endif
-        if(signal) call interface_setSIGUSR2(.false.)
+        if (signal) call interface_setSIGUSR2(.false.)
         call MPI_Allreduce(interface_SIGTERM,signal,1,MPI_LOGICAL,MPI_LOR,MPI_COMM_WORLD,ierr)
         if (ierr /= 0) error stop 'MPI error'
         if (signal) exit loadCaseLooping
@@ -473,7 +473,7 @@ program DAMASK_grid
 
 !--------------------------------------------------------------------------------------------------
 ! report summary of whole calculation
-  print'(/,a)', ' ###########################################################################'
+  print'(/,1x,a)', '###########################################################################'
   if (worldrank == 0) close(statUnit)
 
   call quit(0)                                                                                      ! no complains ;)

src/grid/discretization_grid.f90

@@ -72,7 +72,7 @@ subroutine discretization_grid_init(restart)
     fileContent, fname
 
 
-  print'(/,a)', ' <<<+-  discretization_grid init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  discretization_grid init  -+>>>'; flush(IO_STDOUT)
 
 
   if (worldrank == 0) then
@@ -96,9 +96,9 @@ subroutine discretization_grid_init(restart)
   call MPI_Bcast(origin,3,MPI_DOUBLE,0,MPI_COMM_WORLD, ierr)
   if (ierr /= 0) error stop 'MPI error'
 
-  print'(/,a,3(i12  ))',  ' cells  a b c: ', grid
+  print'(/,1x,a,3(i12,1x))',    'cells  a b c: ', grid
-  print'(a,3(es12.5))',   ' size   x y z: ', geomSize
+  print  '(1x,a,3(es12.5,1x))', 'size   x y z: ', geomSize
-  print'(a,3(es12.5))',   ' origin x y z: ', origin
+  print  '(1x,a,3(es12.5,1x))', 'origin x y z: ', origin
 
   if (worldsize>grid(3)) call IO_error(894, ext_msg='number of processes exceeds grid(3)')
 

src/grid/grid_damage_spectral.f90

@@ -76,10 +76,10 @@ subroutine grid_damage_spectral_init()
   character(len=pStringLen) :: &
     snes_type
 
-  print'(/,a)', ' <<<+-  grid_spectral_damage init  -+>>>'
+  print'(/,1x,a)', '<<<+-  grid_spectral_damage init  -+>>>'
 
-  print*, 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
+  print'(/,1x,a)', 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
-  print*, 'https://doi.org/10.1007/978-981-10-6855-3_80'
+  print'(  1x,a)', 'https://doi.org/10.1007/978-981-10-6855-3_80'
 
 !-------------------------------------------------------------------------------------------------
 ! read numerical parameters and do sanity checks
@@ -137,7 +137,7 @@ subroutine grid_damage_spectral_init()
     call SNESVISetVariableBounds(damage_snes,lBound,uBound,ierr)                                    ! variable bounds for variational inequalities like contact mechanics, damage etc.
     call DMRestoreGlobalVector(damage_grid,lBound,ierr); CHKERRQ(ierr)
     call DMRestoreGlobalVector(damage_grid,uBound,ierr); CHKERRQ(ierr)
-  endif
+  end if
 
 !--------------------------------------------------------------------------------------------------
 ! init fields
@@ -187,7 +187,7 @@ function grid_damage_spectral_solution(Delta_t) result(solution)
   else
     solution%converged = .true.
     solution%iterationsNeeded = totalIter
-  endif
+  end if
   stagNorm = maxval(abs(phi_current - phi_stagInc))
   solnNorm = maxval(abs(phi_current))
   call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,MPI_COMM_WORLD,ierr)
@@ -201,14 +201,14 @@ function grid_damage_spectral_solution(Delta_t) result(solution)
   do k = 1, grid3;  do j = 1, grid(2);  do i = 1,grid(1)
     ce = ce + 1
     call homogenization_set_phi(phi_current(i,j,k),ce)
-  enddo; enddo; enddo
+  end do; end do; end do
 
   call VecMin(solution_vec,devNull,phi_min,ierr); CHKERRQ(ierr)
   call VecMax(solution_vec,devNull,phi_max,ierr); CHKERRQ(ierr)
   if (solution%converged) &
-    print'(/,a)', ' ... nonlocal damage converged .....................................'
+    print'(/,1x,a)', '... nonlocal damage converged .....................................'
-  print'(/,a,f8.6,2x,f8.6,2x,e11.4)', ' Minimum|Maximum|Delta Damage      = ', phi_min, phi_max, stagNorm
+  print'(/,1x,a,f8.6,2x,f8.6,2x,e11.4)', 'Minimum|Maximum|Delta Damage      = ', phi_min, phi_max, stagNorm
-  print'(/,a)', ' ==========================================================================='
+  print'(/,1x,a)', '==========================================================================='
   flush(IO_STDOUT)
 
 end function grid_damage_spectral_solution
@@ -238,11 +238,11 @@ subroutine grid_damage_spectral_forward(cutBack)
     do k = 1, grid3;  do j = 1, grid(2);  do i = 1,grid(1)
       ce = ce + 1
       call homogenization_set_phi(phi_current(i,j,k),ce)
-    enddo; enddo; enddo
+    end do; end do; end do
   else
     phi_lastInc = phi_current
     call updateReference
-  endif
+  end if
 
 end subroutine grid_damage_spectral_forward
 
@@ -277,7 +277,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
   do k = 1, grid3;  do j = 1, grid(2);  do i = 1,grid(1)
     ce = ce + 1
     vectorField_real(1:3,i,j,k) = matmul(homogenization_K_phi(ce) - K_ref, vectorField_real(1:3,i,j,k))
-  enddo; enddo; enddo
+  end do; end do; end do
   call utilities_FFTvectorForward
   call utilities_fourierVectorDivergence                                                            !< calculate damage divergence in fourier field
   call utilities_FFTscalarBackward
@@ -287,7 +287,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
     scalarField_real(i,j,k) = params%Delta_t*(scalarField_real(i,j,k) + homogenization_f_phi(phi_current(i,j,k),ce)) &
                             + homogenization_mu_phi(ce)*(phi_lastInc(i,j,k) - phi_current(i,j,k)) &
                             + mu_ref*phi_current(i,j,k)
-  enddo; enddo; enddo
+  end do; end do; end do
 
 !--------------------------------------------------------------------------------------------------
 ! convolution of damage field with green operator
@@ -320,7 +320,7 @@ subroutine updateReference()
   do ce = 1, product(grid(1:2))*grid3
     K_ref  = K_ref  + homogenization_K_phi(ce)
     mu_ref = mu_ref + homogenization_mu_phi(ce)
-  enddo
+  end do
 
   K_ref = K_ref*wgt
   call MPI_Allreduce(MPI_IN_PLACE,K_ref,9,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,ierr)

src/grid/grid_mech_FEM.f90

@@ -116,7 +116,7 @@ subroutine grid_mechanical_FEM_init
     num_grid, &
     debug_grid
 
-  print'(/,a)', ' <<<+-  grid_mechanical_FEM init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  grid_mechanical_FEM init  -+>>>'; flush(IO_STDOUT)
 
 !-------------------------------------------------------------------------------------------------
 ! debugging options
@@ -234,7 +234,7 @@ subroutine grid_mechanical_FEM_init
 !--------------------------------------------------------------------------------------------------
 ! init fields
   restartRead: if (interface_restartInc > 0) then
-    print'(/,a,i0,a)', ' reading restart data of increment ', interface_restartInc, ' from file'
+    print'(/,1x,a,i0,a)', 'reading restart data of increment ', interface_restartInc, ' from file'
 
     fileHandle  = HDF5_openFile(getSolverJobName()//'_restart.hdf5','r')
     groupHandle = HDF5_openGroup(fileHandle,'solver')
@@ -272,7 +272,7 @@ subroutine grid_mechanical_FEM_init
   CHKERRQ(ierr)
 
   restartRead2: if (interface_restartInc > 0) then
-    print'(a,i0,a)', ' reading more restart data of increment ', interface_restartInc, ' from file'
+    print'(1x,a,i0,a)', 'reading more restart data of increment ', interface_restartInc, ' from file'
     call HDF5_read(C_volAvg,groupHandle,'C_volAvg',.false.)
     call MPI_Bcast(C_volAvg,81,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
     if(ierr /=0) error stop 'MPI error'
@@ -442,7 +442,7 @@ subroutine grid_mechanical_FEM_restartWrite
   call DMDAVecGetArrayF90(mechanical_grid,solution_lastInc,u_lastInc,ierr)
   CHKERRQ(ierr)
 
-  print*, 'writing solver data required for restart to file'; flush(IO_STDOUT)
+  print'(1x,a)', 'writing solver data required for restart to file'; flush(IO_STDOUT)
 
   fileHandle  = HDF5_openFile(getSolverJobName()//'_restart.hdf5','w')
   groupHandle = HDF5_addGroup(fileHandle,'solver')
@@ -506,12 +506,12 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,fnorm,reason,dummy,i
     reason = 0
   endif
 
-  print'(1/,a)', ' ... reporting .............................................................'
+  print'(/,1x,a)', '... reporting .............................................................'
-  print'(1/,a,f12.2,a,es8.2,a,es9.2,a)', ' error divergence = ', &
+  print'(/,1x,a,f12.2,a,es8.2,a,es9.2,a)', 'error divergence = ', &
           err_div/divTol,  ' (',err_div,' / m, tol = ',divTol,')'
-  print'(a,f12.2,a,es8.2,a,es9.2,a)',    ' error stress BC  = ', &
+  print'(1x,a,f12.2,a,es8.2,a,es9.2,a)',    'error stress BC  = ', &
           err_BC/BCTol,    ' (',err_BC, ' Pa,  tol = ',BCTol,')'
-  print'(/,a)', ' ==========================================================================='
+  print'(/,1x,a)', '==========================================================================='
   flush(IO_STDOUT)
 
 end subroutine converged
@@ -547,10 +547,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) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
+    if (debugRotation) print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-      ' 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))', &
+    print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-      ' deformation gradient aim       =', transpose(F_aim)
+      'deformation gradient aim       =', transpose(F_aim)
     flush(IO_STDOUT)
   endif newIteration
 

src/grid/grid_mech_spectral_basic.f90

@@ -111,13 +111,13 @@ subroutine grid_mechanical_spectral_basic_init
     num_grid, &
     debug_grid
 
-  print'(/,a)', ' <<<+-  grid_mechanical_spectral_basic init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  grid_mechanical_spectral_basic init  -+>>>'; flush(IO_STDOUT)
 
-  print*, 'P. Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013'
+  print'(/,1x,a)', 'P. Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013'
-  print*, 'https://doi.org/10.1016/j.ijplas.2012.09.012'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.1016/j.ijplas.2012.09.012'//IO_EOL
 
-  print*, 'P. Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
+  print'(  1x,a)', 'P. Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
-  print*, 'https://doi.org/10.1016/j.ijplas.2014.02.006'
+  print'(  1x,a)', 'https://doi.org/10.1016/j.ijplas.2014.02.006'
 
 !-------------------------------------------------------------------------------------------------
 ! debugging options
@@ -186,30 +186,30 @@ subroutine grid_mechanical_spectral_basic_init
   call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)                                   ! places pointer on PETSc data
 
   restartRead: if (interface_restartInc > 0) then
-    print'(/,a,i0,a)', ' reading restart data of increment ', interface_restartInc, ' from file'
+    print'(/,1x,a,i0,a)', 'reading restart data of increment ', interface_restartInc, ' from file'
 
     fileHandle  = HDF5_openFile(getSolverJobName()//'_restart.hdf5','r')
     groupHandle = HDF5_openGroup(fileHandle,'solver')
 
     call HDF5_read(P_aim,groupHandle,'P_aim',.false.)
     call MPI_Bcast(P_aim,9,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(F_aim,groupHandle,'F_aim',.false.)
     call MPI_Bcast(F_aim,9,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(F_aim_lastInc,groupHandle,'F_aim_lastInc',.false.)
     call MPI_Bcast(F_aim_lastInc,9,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(F_aimDot,groupHandle,'F_aimDot',.false.)
     call MPI_Bcast(F_aimDot,9,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(F,groupHandle,'F')
     call HDF5_read(F_lastInc,groupHandle,'F_lastInc')
 
   elseif (interface_restartInc == 0) then restartRead
     F_lastInc = spread(spread(spread(math_I3,3,grid(1)),4,grid(2)),5,grid3)                         ! initialize to identity
     F = reshape(F_lastInc,[9,grid(1),grid(2),grid3])
-  endif restartRead
+  end if restartRead
 
   homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3])                            ! set starting condition for homogenization_mechanical_response
   call utilities_updateCoords(reshape(F,shape(F_lastInc)))
@@ -219,13 +219,13 @@ subroutine grid_mechanical_spectral_basic_init
   call DMDAVecRestoreArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)                                ! deassociate pointer
 
   restartRead2: if (interface_restartInc > 0) then
-    print'(a,i0,a)', ' reading more restart data of increment ', interface_restartInc, ' from file'
+    print'(1x,a,i0,a)', 'reading more restart data of increment ', interface_restartInc, ' from file'
     call HDF5_read(C_volAvg,groupHandle,'C_volAvg',.false.)
     call MPI_Bcast(C_volAvg,81,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(C_volAvgLastInc,groupHandle,'C_volAvgLastInc',.false.)
     call MPI_Bcast(C_volAvgLastInc,81,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
 
     call HDF5_closeGroup(groupHandle)
     call HDF5_closeFile(fileHandle)
@@ -234,7 +234,7 @@ subroutine grid_mechanical_spectral_basic_init
                        MPI_MODE_RDONLY,MPI_INFO_NULL,fileUnit,ierr)
     call MPI_File_read(fileUnit,C_minMaxAvg,81,MPI_DOUBLE,MPI_STATUS_IGNORE,ierr)
     call MPI_File_close(fileUnit,ierr)
-  endif restartRead2
+  end if restartRead2
 
   call utilities_updateGamma(C_minMaxAvg)
   call utilities_saveReferenceStiffness
@@ -263,7 +263,7 @@ function grid_mechanical_spectral_basic_solution(incInfoIn) result(solution)
 !--------------------------------------------------------------------------------------------------
 ! update stiffness (and gamma operator)
   S = utilities_maskedCompliance(params%rotation_BC,params%stress_mask,C_volAvg)
-  if(num%update_gamma) call utilities_updateGamma(C_minMaxAvg)
+  if (num%update_gamma) call utilities_updateGamma(C_minMaxAvg)
 
 !--------------------------------------------------------------------------------------------------
 ! solve BVP
@@ -328,7 +328,7 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
     elseif (deformation_BC%myType=='F') then                                                        ! aim at end of load case is prescribed
       F_aimDot = F_aimDot &
                + merge(.0_pReal,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
-    endif
+    end if
 
     Fdot = utilities_calculateRate(guess, &
                                    F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),Delta_t_old, &
@@ -336,7 +336,7 @@ subroutine grid_mechanical_spectral_basic_forward(cutBack,guess,Delta_t,Delta_t_
     F_lastInc = reshape(F,[3,3,grid(1),grid(2),grid3])
 
     homogenization_F0 = reshape(F,[3,3,product(grid(1:2))*grid3])
-  endif
+  end if
 
 !--------------------------------------------------------------------------------------------------
 ! update average and local deformation gradients
@@ -385,7 +385,7 @@ subroutine grid_mechanical_spectral_basic_restartWrite
 
   call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr)
 
-  print*, 'writing solver data required for restart to file'; flush(IO_STDOUT)
+  print'(1x,a)', 'writing solver data required for restart to file'; flush(IO_STDOUT)
 
   fileHandle  = HDF5_openFile(getSolverJobName()//'_restart.hdf5','w')
   groupHandle = HDF5_addGroup(fileHandle,'solver')
@@ -406,7 +406,7 @@ subroutine grid_mechanical_spectral_basic_restartWrite
     call HDF5_write(C_minMaxAvg,groupHandle,'C_minMaxAvg',.false.)
     call HDF5_closeGroup(groupHandle)
     call HDF5_closeFile(fileHandle)
-  endif
+  end if
 
   if (num%update_gamma) call utilities_saveReferenceStiffness
 
@@ -443,14 +443,14 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
     reason = -1
   else
     reason = 0
-  endif
+  end if
 
-  print'(1/,a)', ' ... reporting .............................................................'
+  print'(/,1x,a)', '... reporting .............................................................'
-  print'(1/,a,f12.2,a,es8.2,a,es9.2,a)', ' error divergence = ', &
+  print'(/,1x,a,f12.2,a,es8.2,a,es9.2,a)', 'error divergence = ', &
           err_div/divTol,  ' (',err_div,' / m, tol = ',divTol,')'
-  print'(a,f12.2,a,es8.2,a,es9.2,a)',    ' error stress BC  = ', &
+  print'(1x,a,f12.2,a,es8.2,a,es9.2,a)',    'error stress BC  = ', &
           err_BC/BCTol,    ' (',err_BC, ' Pa,  tol = ',BCTol,')'
-  print'(/,a)', ' ==========================================================================='
+  print'(/,1x,a)', '==========================================================================='
   flush(IO_STDOUT)
 
 end subroutine converged
@@ -485,12 +485,12 @@ 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) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
+    if (debugRotation) print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-      ' 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))', &
+    print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-      ' deformation gradient aim       =', transpose(F_aim)
+      'deformation gradient aim       =', transpose(F_aim)
     flush(IO_STDOUT)
-  endif newIteration
+  end if newIteration
 
 !--------------------------------------------------------------------------------------------------
 ! evaluate constitutive response

src/grid/grid_mech_spectral_polarisation.f90

@@ -124,10 +124,10 @@ subroutine grid_mechanical_spectral_polarisation_init
     num_grid, &
     debug_grid
 
-  print'(/,a)', ' <<<+-  grid_mechanical_spectral_polarization init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  grid_mechanical_spectral_polarization init  -+>>>'; flush(IO_STDOUT)
 
-  print*, 'P. Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
+  print'(/,1x,a)', 'P. Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
-  print*, 'https://doi.org/10.1016/j.ijplas.2014.02.006'
+  print'(  1x,a)', 'https://doi.org/10.1016/j.ijplas.2014.02.006'
 
 !-------------------------------------------------------------------------------------------------
 ! debugging options
@@ -208,23 +208,23 @@ subroutine grid_mechanical_spectral_polarisation_init
   F_tau => FandF_tau(9:17,:,:,:)
 
   restartRead: if (interface_restartInc > 0) then
-    print'(/,a,i0,a)', ' reading restart data of increment ', interface_restartInc, ' from file'
+    print'(/,1x,a,i0,a)', 'reading restart data of increment ', interface_restartInc, ' from file'
 
     fileHandle  = HDF5_openFile(getSolverJobName()//'_restart.hdf5','r')
     groupHandle = HDF5_openGroup(fileHandle,'solver')
 
     call HDF5_read(P_aim,groupHandle,'P_aim',.false.)
     call MPI_Bcast(P_aim,9,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(F_aim,groupHandle,'F_aim',.false.)
     call MPI_Bcast(F_aim,9,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(F_aim_lastInc,groupHandle,'F_aim_lastInc',.false.)
     call MPI_Bcast(F_aim_lastInc,9,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(F_aimDot,groupHandle,'F_aimDot',.false.)
     call MPI_Bcast(F_aimDot,9,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(F,groupHandle,'F')
     call HDF5_read(F_lastInc,groupHandle,'F_lastInc')
     call HDF5_read(F_tau,groupHandle,'F_tau')
@@ -235,7 +235,7 @@ subroutine grid_mechanical_spectral_polarisation_init
     F = reshape(F_lastInc,[9,grid(1),grid(2),grid3])
     F_tau = 2.0_pReal*F
     F_tau_lastInc = 2.0_pReal*F_lastInc
-  endif restartRead
+  end if restartRead
 
   homogenization_F0 = reshape(F_lastInc, [3,3,product(grid(1:2))*grid3])                            ! set starting condition for homogenization_mechanical_response
   call utilities_updateCoords(reshape(F,shape(F_lastInc)))
@@ -245,13 +245,13 @@ subroutine grid_mechanical_spectral_polarisation_init
   call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr)                        ! deassociate pointer
 
   restartRead2: if (interface_restartInc > 0) then
-    print'(a,i0,a)', ' reading more restart data of increment ', interface_restartInc, ' from file'
+    print'(1x,a,i0,a)', 'reading more restart data of increment ', interface_restartInc, ' from file'
     call HDF5_read(C_volAvg,groupHandle,'C_volAvg',.false.)
     call MPI_Bcast(C_volAvg,81,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
     call HDF5_read(C_volAvgLastInc,groupHandle,'C_volAvgLastInc',.false.)
     call MPI_Bcast(C_volAvgLastInc,81,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-    if(ierr /=0) error stop 'MPI error'
+    if (ierr /=0) error stop 'MPI error'
 
     call HDF5_closeGroup(groupHandle)
     call HDF5_closeFile(fileHandle)
@@ -260,7 +260,7 @@ subroutine grid_mechanical_spectral_polarisation_init
                        MPI_MODE_RDONLY,MPI_INFO_NULL,fileUnit,ierr)
     call MPI_File_read(fileUnit,C_minMaxAvg,81,MPI_DOUBLE,MPI_STATUS_IGNORE,ierr)
     call MPI_File_close(fileUnit,ierr)
-  endif restartRead2
+  end if restartRead2
 
   call utilities_updateGamma(C_minMaxAvg)
   call utilities_saveReferenceStiffness
@@ -291,11 +291,11 @@ function grid_mechanical_spectral_polarisation_solution(incInfoIn) result(soluti
 !--------------------------------------------------------------------------------------------------
 ! update stiffness (and gamma operator)
   S = utilities_maskedCompliance(params%rotation_BC,params%stress_mask,C_volAvg)
-  if(num%update_gamma) then
+  if (num%update_gamma) then
     call utilities_updateGamma(C_minMaxAvg)
     C_scale = C_minMaxAvg
     S_scale = math_invSym3333(C_minMaxAvg)
-  endif
+  end if
 
 !--------------------------------------------------------------------------------------------------
 ! solve BVP
@@ -364,7 +364,7 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
     elseif (deformation_BC%myType=='F') then                                                        ! aim at end of load case is prescribed
       F_aimDot = F_aimDot &
                + merge(.0_pReal,(deformation_BC%values - F_aim_lastInc)/t_remaining,deformation_BC%mask)
-    endif
+    end if
 
     Fdot     = utilities_calculateRate(guess, &
                                        F_lastInc,reshape(F,[3,3,grid(1),grid(2),grid3]),Delta_t_old, &
@@ -376,14 +376,14 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
     F_tau_lastInc = reshape(F_tau,[3,3,grid(1),grid(2),grid3])
 
     homogenization_F0 = reshape(F,[3,3,product(grid(1:2))*grid3])
-  endif
+  end if
 
 !--------------------------------------------------------------------------------------------------
 ! update average and local deformation gradients
   F_aim = F_aim_lastInc + F_aimDot * Delta_t
-  if(stress_BC%myType=='P')     P_aim = P_aim &
+  if (stress_BC%myType=='P')     P_aim = P_aim &
                                       + merge(.0_pReal,(stress_BC%values - P_aim)/t_remaining,stress_BC%mask)*Delta_t
-  if(stress_BC%myType=='dot_P') P_aim = P_aim &
+  if (stress_BC%myType=='dot_P') P_aim = P_aim &
                                       + merge(.0_pReal,stress_BC%values,stress_BC%mask)*Delta_t
 
   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
@@ -399,8 +399,8 @@ subroutine grid_mechanical_spectral_polarisation_forward(cutBack,guess,Delta_t,D
                   + math_mul3333xx33(S_scale,0.5_pReal*matmul(F_lambda33, &
                     math_mul3333xx33(C_scale,matmul(transpose(F_lambda33),F_lambda33)-math_I3)))
        F_tau(1:9,i,j,k) = reshape(F_lambda33,[9])+F(1:9,i,j,k)
-    enddo; enddo; enddo
+    end do; end do; end do
-  endif
+  end if
 
   call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr)
 
@@ -441,7 +441,7 @@ subroutine grid_mechanical_spectral_polarisation_restartWrite
   F     => FandF_tau(0: 8,:,:,:)
   F_tau => FandF_tau(9:17,:,:,:)
 
-  print*, 'writing solver data required for restart to file'; flush(IO_STDOUT)
+  print'(1x,a)', 'writing solver data required for restart to file'; flush(IO_STDOUT)
 
   fileHandle  = HDF5_openFile(getSolverJobName()//'_restart.hdf5','w')
   groupHandle = HDF5_addGroup(fileHandle,'solver')
@@ -463,9 +463,9 @@ subroutine grid_mechanical_spectral_polarisation_restartWrite
     call HDF5_write(C_volAvgLastInc,groupHandle,'C_volAvgLastInc',.false.)
     call HDF5_closeGroup(groupHandle)
     call HDF5_closeFile(fileHandle)
-  endif
+  end if
 
-  if(num%update_gamma) call utilities_saveReferenceStiffness
+  if (num%update_gamma) call utilities_saveReferenceStiffness
 
   call DMDAVecRestoreArrayF90(da,solution_vec,FandF_tau,ierr); CHKERRQ(ierr)
 
@@ -502,16 +502,16 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
     reason = -1
   else
     reason = 0
-  endif
+  end if
 
-  print'(1/,a)', ' ... reporting .............................................................'
+  print'(/,1x,a)', '... reporting .............................................................'
-  print'(1/,a,f12.2,a,es8.2,a,es9.2,a)', ' error divergence = ', &
+  print'(/,1x,a,f12.2,a,es8.2,a,es9.2,a)', 'error divergence = ', &
             err_div/divTol,  ' (',err_div, ' / m, tol = ',divTol,')'
-  print  '(a,f12.2,a,es8.2,a,es9.2,a)', ' error curl       = ', &
+  print  '(1x,a,f12.2,a,es8.2,a,es9.2,a)', 'error curl       = ', &
             err_curl/curlTol,' (',err_curl,' -,   tol = ',curlTol,')'
-  print  '(a,f12.2,a,es8.2,a,es9.2,a)', ' error stress BC  = ', &
+  print  '(1x,a,f12.2,a,es8.2,a,es9.2,a)', 'error stress BC  = ', &
             err_BC/BCTol,    ' (',err_BC,  ' Pa,  tol = ',BCTol,')'
-  print'(/,a)', ' ==========================================================================='
+  print'(/,1x,a)', '==========================================================================='
   flush(IO_STDOUT)
 
 end subroutine converged
@@ -565,12 +565,12 @@ 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) print'(/,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
+    if (debugRotation) print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-      ' 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))', &
+    print'(/,1x,a,/,2(3(f12.7,1x)/),3(f12.7,1x))', &
-      ' deformation gradient aim       =', transpose(F_aim)
+      'deformation gradient aim       =', transpose(F_aim)
     flush(IO_STDOUT)
-  endif newIteration
+  end if newIteration
 
 !--------------------------------------------------------------------------------------------------
 !
@@ -580,7 +580,7 @@ subroutine formResidual(in, FandF_tau, &
       num%beta*math_mul3333xx33(C_scale,F(1:3,1:3,i,j,k) - math_I3) -&
       num%alpha*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))
-  enddo; enddo; enddo
+  end do; end do; end do
 
 !--------------------------------------------------------------------------------------------------
 ! doing convolution in Fourier space
@@ -621,7 +621,7 @@ subroutine formResidual(in, FandF_tau, &
                        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)
-  enddo; enddo; enddo
+  end do; end do; end do
 
 !--------------------------------------------------------------------------------------------------
 ! calculating curl

src/grid/grid_thermal_spectral.f90

@@ -75,10 +75,10 @@ subroutine grid_thermal_spectral_init(T_0)
   class(tNode), pointer :: &
     num_grid
 
-  print'(/,a)', ' <<<+-  grid_thermal_spectral init  -+>>>'
+  print'(/,1x,a)', '<<<+-  grid_thermal_spectral init  -+>>>'
 
-  print*, 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
+  print'(/,1x,a)', 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
-  print*, 'https://doi.org/10.1007/978-981-10-6855-3_80'
+  print'(  1x,a)', 'https://doi.org/10.1007/978-981-10-6855-3_80'
 
 !-------------------------------------------------------------------------------------------------
 ! read numerical parameters and do sanity checks
@@ -141,7 +141,7 @@ subroutine grid_thermal_spectral_init(T_0)
     T_lastInc(i,j,k) = T_current(i,j,k)
     T_stagInc(i,j,k) = T_current(i,j,k)
     call homogenization_thermal_setField(T_0,0.0_pReal,ce)
-  enddo; enddo; enddo
+  end do; end do; end do
 
   call DMDAVecGetArrayF90(thermal_grid,solution_vec,T_PETSc,ierr); CHKERRQ(ierr)
   T_PETSc(xstart:xend,ystart:yend,zstart:zend) = T_current
@@ -182,7 +182,7 @@ function grid_thermal_spectral_solution(Delta_t) result(solution)
   else
     solution%converged = .true.
     solution%iterationsNeeded = totalIter
-  endif
+  end if
   stagNorm = maxval(abs(T_current - T_stagInc))
   solnNorm = maxval(abs(T_current))
   call MPI_Allreduce(MPI_IN_PLACE,stagNorm,1,MPI_DOUBLE,MPI_MAX,MPI_COMM_WORLD,ierr)
@@ -196,14 +196,14 @@ function grid_thermal_spectral_solution(Delta_t) result(solution)
   do k = 1, grid3;  do j = 1, grid(2);  do i = 1,grid(1)
     ce = ce + 1
     call homogenization_thermal_setField(T_current(i,j,k),(T_current(i,j,k)-T_lastInc(i,j,k))/params%Delta_t,ce)
-  enddo; enddo; enddo
+  end do; end do; end do
 
   call VecMin(solution_vec,devNull,T_min,ierr); CHKERRQ(ierr)
   call VecMax(solution_vec,devNull,T_max,ierr); CHKERRQ(ierr)
   if (solution%converged) &
-    print'(/,a)', ' ... thermal conduction converged ..................................'
+    print'(/,1x,a)', '... thermal conduction converged ..................................'
-  print'(/,a,f8.4,2x,f8.4,2x,f8.4)', ' Minimum|Maximum|Delta Temperature / K = ', T_min, T_max, stagNorm
+  print'(/,1x,a,f8.4,2x,f8.4,2x,f8.4)', 'Minimum|Maximum|Delta Temperature / K = ', T_min, T_max, stagNorm
-  print'(/,a)', ' ==========================================================================='
+  print'(/,1x,a)', '==========================================================================='
   flush(IO_STDOUT)
 
 end function grid_thermal_spectral_solution
@@ -234,11 +234,11 @@ subroutine grid_thermal_spectral_forward(cutBack)
     do k = 1, grid3;  do j = 1, grid(2);  do i = 1,grid(1)
       ce = ce + 1
       call homogenization_thermal_setField(T_current(i,j,k),(T_current(i,j,k)-T_lastInc(i,j,k))/params%Delta_t,ce)
-    enddo; enddo; enddo
+    end do; end do; end do
   else
     T_lastInc = T_current
     call updateReference
-  endif
+  end if
 
 end subroutine grid_thermal_spectral_forward
 
@@ -272,7 +272,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
   do k = 1, grid3;  do j = 1, grid(2);  do i = 1,grid(1)
     ce = ce + 1
     vectorField_real(1:3,i,j,k) = matmul(homogenization_K_T(ce) - K_ref, vectorField_real(1:3,i,j,k))
-  enddo; enddo; enddo
+  end do; end do; end do
   call utilities_FFTvectorForward
   call utilities_fourierVectorDivergence                                                            !< calculate temperature divergence in fourier field
   call utilities_FFTscalarBackward
@@ -282,7 +282,7 @@ subroutine formResidual(in,x_scal,f_scal,dummy,ierr)
     scalarField_real(i,j,k) = params%Delta_t*(scalarField_real(i,j,k) + homogenization_f_T(ce)) &
                             + homogenization_mu_T(ce) * (T_lastInc(i,j,k) - T_current(i,j,k)) &
                             + mu_ref*T_current(i,j,k)
-  enddo; enddo; enddo
+  end do; end do; end do
 
 !--------------------------------------------------------------------------------------------------
 ! convolution of temperature field with green operator
@@ -310,7 +310,7 @@ subroutine updateReference()
   do ce = 1, product(grid(1:2))*grid3
     K_ref  = K_ref  + homogenization_K_T(ce)
     mu_ref = mu_ref + homogenization_mu_T(ce)
-  enddo
+  end do
 
   K_ref = K_ref*wgt
   call MPI_Allreduce(MPI_IN_PLACE,K_ref,9,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,ierr)

src/grid/spectral_utilities.f90

@@ -177,19 +177,19 @@ subroutine spectral_utilities_init
     num_grid, &
     debug_grid                                                                                      ! pointer to grid  debug options
 
-  print'(/,a)', ' <<<+-  spectral_utilities init  -+>>>'
+  print'(/,1x,a)', '<<<+-  spectral_utilities init  -+>>>'
 
-  print*, 'M. Diehl, Diploma Thesis TU München, 2010'
+  print'(/,1x,a)', 'M. Diehl, Diploma Thesis TU München, 2010'
-  print*, 'https://doi.org/10.13140/2.1.3234.3840'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.13140/2.1.3234.3840'//IO_EOL
 
-  print*, 'P. Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013'
+  print'(  1x,a)', 'P. Eisenlohr et al., International Journal of Plasticity 46:37–53, 2013'
-  print*, 'https://doi.org/10.1016/j.ijplas.2012.09.012'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.1016/j.ijplas.2012.09.012'//IO_EOL
 
-  print*, 'P. Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
+  print'(  1x,a)', 'P. Shanthraj et al., International Journal of Plasticity 66:31–45, 2015'
-  print*, 'https://doi.org/10.1016/j.ijplas.2014.02.006'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.1016/j.ijplas.2014.02.006'//IO_EOL
 
-  print*, 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
+  print'(  1x,a)', 'P. Shanthraj et al., Handbook of Mechanics of Materials, 2019'
-  print*, 'https://doi.org/10.1007/978-981-10-6855-3_80'
+  print'(  1x,a)', 'https://doi.org/10.1007/978-981-10-6855-3_80'
 
 !--------------------------------------------------------------------------------------------------
 ! set debugging parameters
@@ -200,15 +200,15 @@ subroutine spectral_utilities_init
   debugRotation   =  debug_grid%contains('rotation')
   debugPETSc      =  debug_grid%contains('PETSc')
 
-  if(debugPETSc) print'(3(/,a),/)', &
+  if (debugPETSc) print'(3(/,1x,a),/)', &
-                 ' Initializing PETSc with debug options: ', &
+                 'Initializing PETSc with debug options: ', &
                  trim(PETScDebug), &
-                 ' add more using the "PETSc_options" keyword in numerics.yaml'
+                 'add more using the "PETSc_options" keyword in numerics.yaml'
   flush(IO_STDOUT)
 
   call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr)
   CHKERRQ(ierr)
-  if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
+  if (debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr)
   CHKERRQ(ierr)
   call PetscOptionsInsertString(PETSC_NULL_OPTIONS,&
                                 num_grid%get_asString('PETSc_options',defaultVal=''),ierr)
@@ -271,7 +271,7 @@ subroutine spectral_utilities_init
   if (pReal /= C_DOUBLE .or. kind(1) /= C_INT) error stop 'C and Fortran datatypes do not match'
   call fftw_set_timelimit(num_grid%get_asFloat('fftw_timelimit',defaultVal=-1.0_pReal))
 
-  print*, 'FFTW initialized'; flush(IO_STDOUT)
+  print'(/,1x,a)', 'FFTW initialized'; flush(IO_STDOUT)
 
 !--------------------------------------------------------------------------------------------------
 ! MPI allocation
@@ -342,10 +342,10 @@ subroutine spectral_utilities_init
 ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around)
   do k = grid3Offset+1, grid3Offset+grid3
     k_s(3) = k - 1
-    if(k > grid(3)/2 + 1) k_s(3) = k_s(3) - grid(3)                                                 ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1
+    if (k > grid(3)/2 + 1) k_s(3) = k_s(3) - grid(3)                                                 ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1
       do j = 1, grid(2)
         k_s(2) = j - 1
-        if(j > grid(2)/2 + 1) k_s(2) = k_s(2) - grid(2)                                             ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1
+        if (j > grid(2)/2 + 1) k_s(2) = k_s(2) - grid(2)                                             ! running from 0,1,...,N/2,N/2+1,-N/2,-N/2+1,...,-1
           do i = 1, grid1Red
             k_s(1) = i - 1                                                                          ! symmetry, junst running from 0,1,...,N/2,N/2+1
             xi2nd(1:3,i,j,k-grid3Offset) = utilities_getFreqDerivative(k_s)
@@ -357,7 +357,7 @@ subroutine spectral_utilities_init
             endwhere
   enddo; enddo; enddo
 
-  if(num%memory_efficient) then                                                                     ! allocate just single fourth order tensor
+  if (num%memory_efficient) then                                                                     ! allocate just single fourth order tensor
     allocate (gamma_hat(3,3,3,3,1,1,1), source = cmplx(0.0_pReal,0.0_pReal,pReal))
   else                                                                                              ! precalculation of gamma_hat field
     allocate (gamma_hat(3,3,3,3,grid1Red,grid(2),grid3), source = cmplx(0.0_pReal,0.0_pReal,pReal))
@@ -384,7 +384,7 @@ subroutine utilities_updateGamma(C)
 
   C_ref = C
 
-  if(.not. num%memory_efficient) then
+  if (.not. num%memory_efficient) then
     gamma_hat =  cmplx(0.0_pReal,0.0_pReal,pReal)                                                   ! for the singular point and any non invertible A
     do k = grid3Offset+1, grid3Offset+grid3; do j = 1, grid(2); do i = 1, grid1Red
       if (any([i,j,k] /= 1)) then                                                                   ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
@@ -497,12 +497,12 @@ subroutine utilities_fourierGammaConvolution(fieldAim)
   logical :: err
 
 
-  print'(/,a)', ' ... doing gamma convolution ...............................................'
+  print'(/,1x,a)', '... doing gamma convolution ...............................................'
   flush(IO_STDOUT)
 
 !--------------------------------------------------------------------------------------------------
 ! do the actual spectral method calculation (mechanical equilibrium)
-  memoryEfficient: if(num%memory_efficient) then
+  memoryEfficient: if (num%memory_efficient) then
     do k = 1, grid3; do j = 1, grid(2); do i = 1, grid1Red
       if (any([i,j,k+grid3Offset] /= 1)) then                                                       ! singular point at xi=(0.0,0.0,0.0) i.e. i=j=k=1
         forall(l = 1:3, m = 1:3) &
@@ -567,7 +567,7 @@ real(pReal) function utilities_divergenceRMS()
   integer :: i, j, k, ierr
   complex(pReal), dimension(3)   :: rescaledGeom
 
-  print'(/,a)', ' ... calculating divergence ................................................'
+  print'(/,1x,a)', '... calculating divergence ................................................'
   flush(IO_STDOUT)
 
   rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal)
@@ -593,9 +593,9 @@ real(pReal) function utilities_divergenceRMS()
                + sum(aimag(matmul(tensorField_fourier(1:3,1:3,grid1Red,j,k), &
                                   conjg(-xi1st(1:3,grid1Red,j,k))*rescaledGeom))**2.0_pReal)
   enddo; enddo
-  if(grid(1) == 1) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal                    ! counted twice in case of grid(1) == 1
+  if (grid(1) == 1) utilities_divergenceRMS = utilities_divergenceRMS * 0.5_pReal                    ! counted twice in case of grid(1) == 1
   call MPI_Allreduce(MPI_IN_PLACE,utilities_divergenceRMS,1,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,ierr)
-  if(ierr /=0) error stop 'MPI error'
+  if (ierr /=0) error stop 'MPI error'
   utilities_divergenceRMS = sqrt(utilities_divergenceRMS) * wgt                                     ! RMS in real space calculated with Parsevals theorem from Fourier space
 
 end function utilities_divergenceRMS
@@ -610,7 +610,7 @@ real(pReal) function utilities_curlRMS()
   complex(pReal), dimension(3,3) :: curl_fourier
   complex(pReal), dimension(3)   :: rescaledGeom
 
-  print'(/,a)', ' ... calculating curl ......................................................'
+  print'(/,1x,a)', '... calculating curl ......................................................'
   flush(IO_STDOUT)
 
   rescaledGeom = cmplx(geomSize/scaledGeomSize,0.0_pReal)
@@ -655,9 +655,9 @@ real(pReal) function utilities_curlRMS()
   enddo; enddo
 
   call MPI_Allreduce(MPI_IN_PLACE,utilities_curlRMS,1,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,ierr)
-  if(ierr /=0) error stop 'MPI error'
+  if (ierr /=0) error stop 'MPI error'
   utilities_curlRMS = sqrt(utilities_curlRMS) * wgt
-  if(grid(1) == 1) utilities_curlRMS = utilities_curlRMS * 0.5_pReal                                ! counted twice in case of grid(1) == 1
+  if (grid(1) == 1) utilities_curlRMS = utilities_curlRMS * 0.5_pReal                                ! counted twice in case of grid(1) == 1
 
 end function utilities_curlRMS
 
@@ -686,13 +686,13 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
 
   mask_stressVector = .not. reshape(transpose(mask_stress), [9])
   size_reduced = count(mask_stressVector)
-  if(size_reduced > 0) then
+  if (size_reduced > 0) then
     temp99_real = math_3333to99(rot_BC%rotate(C))
 
-    if(debugGeneral) then
+    if (debugGeneral) then
-      print'(/,a)', ' ... updating masked compliance ............................................'
+      print'(/,1x,a)', '... updating masked compliance ............................................'
-      print'(/,a,/,8(9(2x,f12.7,1x)/),9(2x,f12.7,1x))', &
+      print'(/,1x,a,/,8(9(2x,f12.7,1x)/),9(2x,f12.7,1x))', &
-        ' Stiffness C (load) / GPa =', transpose(temp99_Real)*1.0e-9_pReal
+        'Stiffness C (load) / GPa =', transpose(temp99_Real)*1.0e-9_pReal
       flush(IO_STDOUT)
     endif
 
@@ -711,10 +711,10 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
     errmatinv = errmatinv .or. any(dNeq(sTimesC,math_eye(size_reduced),1.0e-12_pReal))
     if (debugGeneral .or. errmatinv) then
       write(formatString, '(i2)') size_reduced
-      formatString = '(/,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))'
+      formatString = '(/,1x,a,/,'//trim(formatString)//'('//trim(formatString)//'(2x,es9.2,1x)/))'
-      print trim(formatString), ' C * S (load) ', transpose(matmul(c_reduced,s_reduced))
+      print trim(formatString), 'C * S (load) ', transpose(matmul(c_reduced,s_reduced))
-      print trim(formatString), ' S (load) ', transpose(s_reduced)
+      print trim(formatString), 'S (load) ', transpose(s_reduced)
-      if(errmatinv) error stop 'matrix inversion error'
+      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])
   else
@@ -723,9 +723,9 @@ function utilities_maskedCompliance(rot_BC,mask_stress,C)
 
   utilities_maskedCompliance = math_99to3333(temp99_Real)
 
-  if(debugGeneral) then
+  if (debugGeneral) then
-    print'(/,a,/,9(9(2x,f10.5,1x)/),9(2x,f10.5,1x))', &
+    print'(/,1x,a,/,9(9(2x,f10.5,1x)/),9(2x,f10.5,1x))', &
-      ' Masked Compliance (load) * GPa =', transpose(temp99_Real)*1.0e9_pReal
+      'Masked Compliance (load) * GPa =', transpose(temp99_Real)*1.0e9_pReal
     flush(IO_STDOUT)
   endif
 
@@ -810,7 +810,7 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
   real(pReal)                     :: dPdF_norm_max, dPdF_norm_min
   real(pReal), dimension(2) :: valueAndRank                                                         !< pair of min/max norm of dPdF to synchronize min/max of dPdF
 
-  print'(/,a)', ' ... evaluating constitutive response ......................................'
+  print'(/,1x,a)', '... evaluating constitutive response ......................................'
   flush(IO_STDOUT)
 
   homogenization_F  = reshape(F,[3,3,product(grid(1:2))*grid3])                                     ! set materialpoint target F to estimated field
@@ -824,11 +824,11 @@ subroutine utilities_constitutiveResponse(P,P_av,C_volAvg,C_minmaxAvg,&
   P = reshape(homogenization_P, [3,3,grid(1),grid(2),grid3])
   P_av = sum(sum(sum(P,dim=5),dim=4),dim=3) * wgt
   call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,MPI_COMM_WORLD,ierr)
-  if (debugRotation) print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
+  if (debugRotation) print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
-    ' Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pReal
+    'Piola--Kirchhoff stress (lab) / MPa =', transpose(P_av)*1.e-6_pReal
-  if(present(rotation_BC)) P_av = rotation_BC%rotate(P_av)
+  if (present(rotation_BC)) P_av = rotation_BC%rotate(P_av)
-  print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
+  print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
-    ' Piola--Kirchhoff stress       / MPa =', transpose(P_av)*1.e-6_pReal
+    'Piola--Kirchhoff stress       / MPa =', transpose(P_av)*1.e-6_pReal
   flush(IO_STDOUT)
 
   dPdF_max = 0.0_pReal
@@ -1017,7 +1017,7 @@ subroutine utilities_updateCoords(F)
   call utilities_FFTtensorForward()
 
   do k = 1, grid3; do j = 1, grid(2); do i = 1, grid1Red
-    if(any([i,j,k+grid3Offset] /= 1)) then
+    if (any([i,j,k+grid3Offset] /= 1)) then
       vectorField_fourier(1:3,i,j,k) = matmul(tensorField_fourier(1:3,1:3,i,j,k),xi2nd(1:3,i,j,k)) &
                                      / sum(conjg(-xi2nd(1:3,i,j,k))*xi2nd(1:3,i,j,k)) * cmplx(wgt,0.0,pReal)
     else
@@ -1031,7 +1031,7 @@ subroutine utilities_updateCoords(F)
  ! average F
   if (grid3Offset == 0) Favg = real(tensorField_fourier(1:3,1:3,1,1,1),pReal)*wgt
   call MPI_Bcast(Favg,9,MPI_DOUBLE,0,MPI_COMM_WORLD,ierr)
-  if(ierr /=0) error stop 'MPI error'
+  if (ierr /=0) error stop 'MPI error'
 
  !--------------------------------------------------------------------------------------------------
  ! pad cell center fluctuations along z-direction (needed when running MPI simulation)
@@ -1042,22 +1042,22 @@ subroutine utilities_updateCoords(F)
 
   ! send bottom layer to process below
   call MPI_Isend(IPfluct_padded(:,:,:,2),      c,MPI_DOUBLE,rank_b,0,MPI_COMM_WORLD,request(1),ierr)
-  if(ierr /=0) error stop 'MPI error'
+  if (ierr /=0) error stop 'MPI error'
   call MPI_Irecv(IPfluct_padded(:,:,:,grid3+2),c,MPI_DOUBLE,rank_t,0,MPI_COMM_WORLD,request(2),ierr)
-  if(ierr /=0) error stop 'MPI error'
+  if (ierr /=0) error stop 'MPI error'
 
   ! send top layer to process above
   call MPI_Isend(IPfluct_padded(:,:,:,grid3+1),c,MPI_DOUBLE,rank_t,1,MPI_COMM_WORLD,request(3),ierr)
-  if(ierr /=0) error stop 'MPI error'
+  if (ierr /=0) error stop 'MPI error'
   call MPI_Irecv(IPfluct_padded(:,:,:,1),      c,MPI_DOUBLE,rank_b,1,MPI_COMM_WORLD,request(4),ierr)
-  if(ierr /=0) error stop 'MPI error'
+  if (ierr /=0) error stop 'MPI error'
 
   call MPI_Waitall(4,request,status,ierr)
-  if(ierr /=0) error stop 'MPI error'
+  if (ierr /=0) error stop 'MPI error'
 #if (PETSC_VERSION_MAJOR==3 && PETSC_VERSION_MINOR>14) && !defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
   ! ToDo
 #else
-  if(any(status(MPI_ERROR,:) /= 0)) error stop 'MPI error'
+  if (any(status(MPI_ERROR,:) /= 0)) error stop 'MPI error'
 #endif
 
  !--------------------------------------------------------------------------------------------------
@@ -1094,10 +1094,10 @@ subroutine utilities_saveReferenceStiffness
     fileUnit,ierr
 
   if (worldrank == 0) then
-    print'(a)', ' writing reference stiffness data required for restart to file'; flush(IO_STDOUT)
+    print'(/,1x,a)', '... writing reference stiffness data required for restart to file .........'; flush(IO_STDOUT)
     open(newunit=fileUnit, file=getSolverJobName()//'.C_ref',&
          status='replace',access='stream',action='write',iostat=ierr)
-    if(ierr /=0) call IO_error(100,ext_msg='could not open file '//getSolverJobName()//'.C_ref')
+    if (ierr /=0) call IO_error(100,ext_msg='could not open file '//getSolverJobName()//'.C_ref')
     write(fileUnit) C_ref
     close(fileUnit)
   endif

src/homogenization.f90

@@ -199,7 +199,7 @@ subroutine homogenization_init()
     num_homog, &
     num_homogGeneric
 
-  print'(/,a)', ' <<<+-  homogenization init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  homogenization init  -+>>>'; flush(IO_STDOUT)
 
 
   allocate(homogState      (size(material_name_homogenization)))

src/homogenization_damage.f90

@@ -41,7 +41,7 @@ module subroutine damage_init()
   integer :: ho,Nmembers
 
 
-  print'(/,a)', ' <<<+-  homogenization:damage init  -+>>>'
+  print'(/,1x,a)', '<<<+-  homogenization:damage init  -+>>>'
 
 
   configHomogenizations => config_material%get('homogenization')

src/homogenization_damage_pass.f90

@@ -8,7 +8,7 @@ contains
 
 module subroutine pass_init()
   
-  print'(/,a)', ' <<<+-  homogenization:damage:pass init  -+>>>'
+  print'(/,1x,a)', '<<<+-  homogenization:damage:pass init  -+>>>'
 
 end subroutine pass_init
 

src/homogenization_mechanical.f90

@@ -68,7 +68,7 @@ module subroutine mechanical_init(num_homog)
   class(tNode), pointer :: &
     num_homogMech
 
-  print'(/,a)', ' <<<+-  homogenization:mechanical init  -+>>>'
+  print'(/,1x,a)', '<<<+-  homogenization:mechanical init  -+>>>'
 
   call material_parseHomogenization2()
 
@@ -114,7 +114,7 @@ module subroutine mechanical_partition(subF,ce)
 
   do co = 1,homogenization_Nconstituents(material_homogenizationID(ce))
     call phase_set_F(Fs(1:3,1:3,co),co,ce)
-  enddo
+  end do
 
 
 end subroutine mechanical_partition
@@ -138,7 +138,7 @@ module subroutine mechanical_homogenize(Delta_t,ce)
                                             + phase_P(co,ce)
     homogenization_dPdF(1:3,1:3,1:3,1:3,ce) = homogenization_dPdF(1:3,1:3,1:3,1:3,ce) &
                                             + phase_mechanical_dPdF(Delta_t,co,ce)
-  enddo
+  end do
 
   homogenization_P(1:3,1:3,ce)            = homogenization_P(1:3,1:3,ce) &
                                           / real(homogenization_Nconstituents(material_homogenizationID(ce)),pReal)
@@ -173,11 +173,11 @@ module function mechanical_updateState(subdt,subF,ce) result(doneAndHappy)
         dPdFs(:,:,:,:,co) = phase_mechanical_dPdF(subdt,co,ce)
         Fs(:,:,co)        = phase_F(co,ce)
         Ps(:,:,co)        = phase_P(co,ce)
-      enddo
+      end do
       doneAndHappy = RGC_updateState(Ps,Fs,subF,subdt,dPdFs,ce)
   else
     doneAndHappy = .true.
-  endif
+  end if
 
 end function mechanical_updateState
 
@@ -241,7 +241,7 @@ subroutine material_parseHomogenization2()
       case default
         call IO_error(500,ext_msg=homogMech%get_asString('type'))
     end select
-  enddo
+  end do
 
 end subroutine material_parseHomogenization2
 

src/homogenization_mechanical_RGC.f90

@@ -87,16 +87,16 @@ module subroutine RGC_init(num_homogMech)
     homog, &
     homogMech
 
-  print'(/,a)', ' <<<+-  homogenization:mechanical:RGC init  -+>>>'
+  print'(/,1x,a)', '<<<+-  homogenization:mechanical:RGC init  -+>>>'
 
-  print'(a,i0)', ' # homogenizations: ',count(homogenization_type == HOMOGENIZATION_RGC_ID)
+  print'(/,a,i0)', ' # homogenizations: ',count(homogenization_type == HOMOGENIZATION_RGC_ID)
   flush(IO_STDOUT)
 
-  print*, 'D.D. Tjahjanto et al., International Journal of Material Forming 2(1):939–942, 2009'
+  print'(/,1x,a)', 'D.D. Tjahjanto et al., International Journal of Material Forming 2(1):939–942, 2009'
-  print*, 'https://doi.org/10.1007/s12289-009-0619-1'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.1007/s12289-009-0619-1'//IO_EOL
 
-  print*, 'D.D. Tjahjanto et al., Modelling and Simulation in Materials Science and Engineering 18:015006, 2010'
+  print'(/,1x,a)', 'D.D. Tjahjanto et al., Modelling and Simulation in Materials Science and Engineering 18:015006, 2010'
-  print*, 'https://doi.org/10.1088/0965-0393/18/1/015006'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.1088/0965-0393/18/1/015006'//IO_EOL
 
 
   material_homogenization => config_material%get('homogenization')
@@ -186,7 +186,7 @@ module subroutine RGC_init(num_homogMech)
 
     end associate
 
-  enddo
+  end do
 
 end subroutine RGC_init
 
@@ -222,9 +222,9 @@ module subroutine RGC_partitionDeformation(F,avgF,ce)
       nVect = interfaceNormal(intFace,ho,en)
       forall (i=1:3,j=1:3) &
         F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j)                                           ! calculating deformation relaxations due to interface relaxation
-    enddo
+    end do
     F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF                                                    ! resulting relaxed deformation gradient
-  enddo
+  end do
 
   end associate
 
@@ -257,10 +257,10 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   real(pReal), dimension(:,:), allocatable :: tract,jmatrix,jnverse,smatrix,pmatrix,rmatrix
   real(pReal), dimension(:), allocatable   :: resid,relax,p_relax,p_resid,drelax
 
-  zeroTimeStep: if(dEq0(dt)) then
+  zeroTimeStep: if (dEq0(dt)) then
     doneAndHappy = .true.                                                                   ! pretend everything is fine and return
     return
-  endif zeroTimeStep
+  end if zeroTimeStep
 
   ho  = material_homogenizationID(ce)
   en = material_homogenizationEntry(ce)
@@ -319,10 +319,10 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
         tract(iNum,i) = tract(iNum,i) + (P(i,j,iGrP) + R(i,j,iGrP) + D(i,j,iGrP))*normP(j) &        ! contribution from material stress P, mismatch penalty R, and volume penalty D projected into the interface
                                       + (P(i,j,iGrN) + R(i,j,iGrN) + D(i,j,iGrN))*normN(j)
         resid(i+3*(iNum-1)) = tract(iNum,i)                                                         ! translate the local residual into global 1-dimensional residual array
-      enddo
+      end do
-    enddo
+    end do
 
-  enddo
+  end do
 
 !--------------------------------------------------------------------------------------------------
 ! convergence check for stress residual
@@ -347,7 +347,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   elseif (residMax > num%relMax*stresMax .or. residMax > num%absMax) then                           ! try to restart when residual blows up exceeding maximum bound
     doneAndHappy = [.true.,.false.]                                                         ! with direct cut-back
    return
-  endif
+  end if
 
 !---------------------------------------------------------------------------------------------------
 ! construct the global Jacobian matrix for updating the global relaxation vector array when
@@ -373,11 +373,11 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
         do i=1,3; do j=1,3; do k=1,3; do l=1,3
           smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) &
                                              + dPdF(i,k,j,l,iGrN)*normN(k)*mornN(l)
-        enddo;enddo;enddo;enddo
+        end do;end do;end do;end do
 ! projecting the material tangent dPdF into the interface
 ! to obtain the Jacobian matrix contribution of dPdF
-      endif
+      end if
-    enddo
+    end do
 
 !--------------------------------------------------------------------------------------------------
 ! identify the right/up/front grain (+|P)
@@ -394,10 +394,10 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
         do i=1,3; do j=1,3; do k=1,3; do l=1,3
           smatrix(3*(iNum-1)+i,3*(iMun-1)+j) = smatrix(3*(iNum-1)+i,3*(iMun-1)+j) &
                                              + dPdF(i,k,j,l,iGrP)*normP(k)*mornP(l)
-        enddo;enddo;enddo;enddo
+        end do;end do;end do;end do
-      endif
+      end if
-    enddo
+    end do
-  enddo
+  end do
 
 !--------------------------------------------------------------------------------------------------
 ! ... of the stress penalty tangent (mismatch penalty and volume penalty, computed using numerical
@@ -443,10 +443,10 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
                                                       + (pR(i,j,iGrN) - R(i,j,iGrN))*normN(j) &
                                                       + (pD(i,j,iGrP) - D(i,j,iGrP))*normP(j) &
                                                       + (pD(i,j,iGrN) - D(i,j,iGrN))*normN(j)
-      enddo; enddo
+      end do; end do
-    enddo
+    end do
     pmatrix(:,ipert) = p_resid/num%pPert
-  enddo
+  end do
 
 
 !--------------------------------------------------------------------------------------------------
@@ -455,7 +455,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   do i=1,3*nIntFaceTot
     rmatrix(i,i) = num%viscModus*num%viscPower/(num%refRelaxRate*dt)* &                             ! tangent due to numerical viscosity traction appears
                    (abs(drelax(i))/(num%refRelaxRate*dt))**(num%viscPower - 1.0_pReal)              ! only in the main diagonal term
-  enddo
+  end do
 
 
 !--------------------------------------------------------------------------------------------------
@@ -472,7 +472,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   drelax = 0.0_pReal
   do i = 1,3*nIntFaceTot;do j = 1,3*nIntFaceTot
     drelax(i) = drelax(i) - jnverse(i,j)*resid(j)                                                   ! Calculate the correction for the state variable
-  enddo; enddo
+  end do; end do
   stt%relaxationVector(:,en) = 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
     doneAndHappy = [.true.,.false.]
@@ -481,7 +481,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
     print'(a,e15.8)',' due to large relaxation change = ',maxval(abs(drelax))
     flush(IO_STDOUT)
     !$OMP END CRITICAL (write2out)
-  endif
+  end if
 
   end associate
 
@@ -545,9 +545,9 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
        do i = 1,3; do j = 1,3
          do k = 1,3; do l = 1,3
            nDef(i,j) = nDef(i,j) - nVect(k)*gDef(i,l)*math_LeviCivita(j,k,l)                        ! compute the interface mismatch tensor from the jump of deformation gradient
-         enddo; enddo
+         end do; end do
          nDefNorm = nDefNorm + nDef(i,j)**2.0_pReal                                                 ! compute the norm of the mismatch tensor
-       enddo; enddo
+       end do; end do
        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)
 
@@ -560,11 +560,11 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
                                                 *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
+       end do; end do;enddo; end do
-     enddo interfaceLoop
+     end do interfaceLoop
 
 
-   enddo grainLoop
+   end do grainLoop
 
    end associate
 
@@ -594,7 +594,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
       gVol(i) = math_det33(fDef(1:3,1:3,i))                                                         ! compute the volume of individual grains
       vDiscrep     = vDiscrep - gVol(i)/real(nGrain,pReal)                                          ! calculate the difference/dicrepancy between
                                                                                                     ! the volume of the cluster and the the total volume of grains
-    enddo
+    end do
 
     !----------------------------------------------------------------------------------------------
     ! calculate the stress and penalty due to volume discrepancy
@@ -603,7 +603,7 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
       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)))
-    enddo
+    end do
 
   end subroutine volumePenalty
 
@@ -633,9 +633,9 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
       nVect = interfaceNormal([iBase,1,1,1],ho,en)
       do i = 1,3; do j = 1,3
         surfaceCorrection(iBase) = surfaceCorrection(iBase) + invC(i,j)*nVect(i)*nVect(j)           ! compute the component of (the inverse of) the stretch in the direction of the normal
-      enddo; enddo
+      end do; end do
       surfaceCorrection(iBase) = sqrt(surfaceCorrection(iBase))*detF                                ! get the surface correction factor (area contraction/enlargement)
-    enddo
+    end do
 
   end function surfaceCorrection
 
@@ -643,16 +643,16 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
   !-------------------------------------------------------------------------------------------------
   !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor
   !-------------------------------------------------------------------------------------------------
-  real(pReal) function equivalentMu(grainID,ce)
+  real(pReal) function equivalentMu(co,ce)
 
     integer, intent(in)    :: &
-      grainID,&
+      co,&
       ce
 
     real(pReal), dimension(6,6) :: C
 
 
-    C = phase_homogenizedC(material_phaseID(grainID,ce),material_phaseEntry(grainID,ce))
+    C = phase_homogenizedC66(material_phaseID(co,ce),material_phaseEntry(co,ce))                    ! damage not included!
     equivalentMu = lattice_equivalent_mu(C,'voigt')
 
   end function equivalentMu
@@ -690,9 +690,9 @@ module function RGC_updateState(P,F,avgF,dt,dPdF,ce) result(doneAndHappy)
         nVect   = interfaceNormal(intFace,ho,en)
         forall (i=1:3,j=1:3) &
           F(i,j,iGrain) = F(i,j,iGrain) + aVect(i)*nVect(j)                                         ! effective relaxations
-      enddo
+      end do
       F(1:3,1:3,iGrain) = F(1:3,1:3,iGrain) + avgF                                                  ! relaxed deformation gradient
-    enddo
+    end do
 
     end associate
 
@@ -727,7 +727,7 @@ module subroutine RGC_results(ho,group)
         call results_writeDataset(dst%relaxationrate_avg,group,trim(prm%output(o)), &
                                   'average relaxation rate','m/s')
     end select
-  enddo outputsLoop
+  end do outputsLoop
   end associate
 
 end subroutine RGC_results
@@ -756,7 +756,7 @@ pure function relaxationVector(intFace,ho,en)
     relaxationVector = stt%relaxationVector((3*iNum-2):(3*iNum),en)
   else
     relaxationVector = 0.0_pReal
-  endif
+  end if
 
   end associate
 
@@ -855,7 +855,7 @@ integer pure function interface4to1(iFace4D, nGDim)
       else
         interface4to1 = iFace4D(3) + nGDim(2)*(iFace4D(4)-1) &
                       + nGDim(2)*nGDim(3)*(iFace4D(2)-1)
-      endif
+      end if
 
     case(2)
       if ((iFace4D(3) == 0) .or. (iFace4D(3) == nGDim(2))) then
@@ -864,7 +864,7 @@ integer pure function interface4to1(iFace4D, nGDim)
         interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1) &
                       + nGDim(3)*nGDim(1)*(iFace4D(3)-1) &
                       + (nGDim(1)-1)*nGDim(2)*nGDim(3)                                              ! total # of interfaces normal || e1
-      endif
+      end if
 
     case(3)
       if ((iFace4D(4) == 0) .or. (iFace4D(4) == nGDim(3))) then
@@ -874,7 +874,7 @@ integer pure function interface4to1(iFace4D, nGDim)
                       + nGDim(1)*nGDim(2)*(iFace4D(4)-1) &
                       + (nGDim(1)-1)*nGDim(2)*nGDim(3) &                                            ! total # of interfaces normal || e1
                       + nGDim(1)*(nGDim(2)-1)*nGDim(3)                                              ! total # of interfaces normal || e2
-      endif
+      end if
 
     case default
       interface4to1 = -1
@@ -918,7 +918,7 @@ pure function interface1to4(iFace1D, nGDim)
     interface1to4(2) = mod((iFace1D-nIntFace(2)-nIntFace(1)-1),nGDim(1))+1
     interface1to4(3) = mod(int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)),nGDim(2))+1
     interface1to4(4) = int(real(iFace1D-nIntFace(2)-nIntFace(1)-1,pReal)/real(nGDim(1),pReal)/real(nGDim(2),pReal))+1
-  endif
+  end if
 
 end function interface1to4
 

src/homogenization_mechanical_isostrain.f90

@@ -17,9 +17,9 @@ module subroutine isostrain_init
     ho, &
     Nmembers
 
-  print'(/,a)', ' <<<+-  homogenization:mechanical:isostrain init  -+>>>'
+  print'(/,1x,a)', '<<<+-  homogenization:mechanical:isostrain init  -+>>>'
 
-  print'(a,i0)', ' # homogenizations: ',count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)
+  print'(/,a,i0)', ' # homogenizations: ',count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)
   flush(IO_STDOUT)
 
   do ho = 1, size(homogenization_type)
@@ -30,7 +30,7 @@ module subroutine isostrain_init
     allocate(homogState(ho)%state0(0,Nmembers))
     allocate(homogState(ho)%state (0,Nmembers))
 
-  enddo
+  end do
 
 end subroutine isostrain_init
 

src/homogenization_mechanical_pass.f90

@@ -17,15 +17,15 @@ module subroutine pass_init
     ho, &
     Nmembers
 
-  print'(/,a)', ' <<<+-  homogenization:mechanical:pass init  -+>>>'
+  print'(/,1x,a)', '<<<+-  homogenization:mechanical:pass init  -+>>>'
 
-  print'(a,i0)', ' # homogenizations: ',count(homogenization_type == HOMOGENIZATION_NONE_ID)
+  print'(/,a,i0)', ' # homogenizations: ',count(homogenization_type == HOMOGENIZATION_NONE_ID)
   flush(IO_STDOUT)
 
   do ho = 1, size(homogenization_type)
-    if(homogenization_type(ho) /= HOMOGENIZATION_NONE_ID) cycle
+    if (homogenization_type(ho) /= HOMOGENIZATION_NONE_ID) cycle
 
-    if(homogenization_Nconstituents(ho) /= 1) &
+    if (homogenization_Nconstituents(ho) /= 1) &
       call IO_error(211,ext_msg='N_constituents (pass)')
 
     Nmembers = count(material_homogenizationID == ho)
@@ -33,7 +33,7 @@ module subroutine pass_init
     allocate(homogState(ho)%state0(0,Nmembers))
     allocate(homogState(ho)%state (0,Nmembers))
 
-  enddo
+  end do
 
 end subroutine pass_init
 

src/homogenization_thermal.f90

@@ -44,7 +44,7 @@ module subroutine thermal_init()
   integer :: ho
 
 
-  print'(/,a)', ' <<<+-  homogenization:thermal init  -+>>>'
+  print'(/,1x,a)', '<<<+-  homogenization:thermal init  -+>>>'
 
 
   configHomogenizations => config_material%get('homogenization')
@@ -65,9 +65,9 @@ module subroutine thermal_init()
 #endif
       else
         prm%output = emptyStringArray
-      endif
+      end if
     end associate
-  enddo
+  end do
 
   call pass_init()
 
@@ -89,7 +89,7 @@ module subroutine thermal_partition(ce)
   dot_T = current(material_homogenizationID(ce))%dot_T(material_homogenizationEntry(ce))
   do co = 1, homogenization_Nconstituents(material_homogenizationID(ce))
     call phase_thermal_setField(T,dot_T,co,ce)
-  enddo
+  end do
 
 end subroutine thermal_partition
 
@@ -108,7 +108,7 @@ module function homogenization_mu_T(ce) result(mu)
   mu = phase_mu_T(1,ce)
   do co = 2, homogenization_Nconstituents(material_homogenizationID(ce))
     mu = mu + phase_mu_T(co,ce)
-  enddo
+  end do
 
   mu = mu / real(homogenization_Nconstituents(material_homogenizationID(ce)),pReal)
 
@@ -129,7 +129,7 @@ module function homogenization_K_T(ce) result(K)
   K = phase_K_T(1,ce)
   do co = 2, homogenization_Nconstituents(material_homogenizationID(ce))
     K = K + phase_K_T(co,ce)
-  enddo
+  end do
 
   K = K / real(homogenization_Nconstituents(material_homogenizationID(ce)),pReal)
 
@@ -150,7 +150,7 @@ module function homogenization_f_T(ce) result(f)
   f = phase_f_T(material_phaseID(1,ce),material_phaseEntry(1,ce))
   do co = 2, homogenization_Nconstituents(material_homogenizationID(ce))
     f = f + phase_f_T(material_phaseID(co,ce),material_phaseEntry(co,ce))
-  enddo
+  end do
 
   f = f/real(homogenization_Nconstituents(material_homogenizationID(ce)),pReal)
 
@@ -189,7 +189,7 @@ module subroutine thermal_results(ho,group)
         case('T')
           call results_writeDataset(current(ho)%T,group,'T','temperature','K')
       end select
-    enddo outputsLoop
+    end do outputsLoop
   end associate
 
 end subroutine thermal_results

src/homogenization_thermal_pass.f90

@@ -8,7 +8,7 @@ contains
 
 module subroutine pass_init()
   
-  print'(/,a)', ' <<<+-  homogenization:thermal:pass init  -+>>>'
+  print'(/,1x,a)', '<<<+-  homogenization:thermal:pass init  -+>>>'
 
 end subroutine pass_init
 

src/lattice.f90

@@ -219,18 +219,18 @@ module lattice
        2, -1, -1,  0,     0,  1, -1,  0, &
       -1,  2, -1,  0,    -1,  0,  1,  0, &
       -1, -1,  2,  0,     1, -1,  0,  0, &
-    ! <-11.0>{11.0}/2nd order prismatic compound systems (plane normal independent of c/a-ratio)
+    ! <-11.0>{11.0}/2. order prismatic compound systems (plane normal independent of c/a-ratio)
       -1,  1,  0,  0,     1,  1, -2,  0, &
        0, -1,  1,  0,    -2,  1,  1,  0, &
        1,  0, -1,  0,     1, -2,  1,  0, &
-    ! <-1-1.0>{-11.1}/1st order pyramidal <a> systems (direction independent of c/a-ratio)
+    ! <-1-1.0>{-11.1}/1. order pyramidal <a> systems (direction independent of c/a-ratio)
       -1,  2, -1,  0,     1,  0, -1,  1, &
       -2,  1,  1,  0,     0,  1, -1,  1, &
       -1, -1,  2,  0,    -1,  1,  0,  1, &
        1, -2,  1,  0,    -1,  0,  1,  1, &
        2, -1, -1,  0,     0, -1,  1,  1, &
        1,  1, -2,  0,     1, -1,  0,  1, &
-    ! <11.3>{-10.1}/1st order pyramidal <c+a> systems (direction independent of c/a-ratio)
+    ! <11.3>{-10.1}/1. order pyramidal <c+a> systems (direction independent of c/a-ratio)
       -2,  1,  1,  3,     1,  0, -1,  1, &
       -1, -1,  2,  3,     1,  0, -1,  1, &
       -1, -1,  2,  3,     0,  1, -1,  1, &
@@ -243,7 +243,7 @@ module lattice
       -1,  2, -1,  3,     0, -1,  1,  1, &
       -1,  2, -1,  3,     1, -1,  0,  1, &
       -2,  1,  1,  3,     1, -1,  0,  1, &
-    ! <11.3>{-1-1.2}/2nd order pyramidal <c+a> systems
+    ! <11.3>{-1-1.2}/2. order pyramidal <c+a> systems
       -1, -1,  2,  3,     1,  1, -2,  2, &
        1, -2,  1,  3,    -1,  2, -1,  2, &
        2, -1, -1,  3,    -2,  1,  1,  2, &
@@ -405,11 +405,11 @@ module lattice
 contains
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Module initialization
+!> @brief module initialization
 !--------------------------------------------------------------------------------------------------
 subroutine lattice_init
 
-  print'(/,a)', ' <<<+-  lattice init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  lattice init  -+>>>'; flush(IO_STDOUT)
 
   call selfTest
 
@@ -417,7 +417,7 @@ end subroutine lattice_init
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Characteristic shear for twinning
+!> @brief characteristic shear for twinning
 !--------------------------------------------------------------------------------------------------
 function lattice_characteristicShear_Twin(Ntwin,lattice,CoverA) result(characteristicShear)
 
@@ -491,7 +491,7 @@ end function lattice_characteristicShear_Twin
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Rotated elasticity matrices for twinning in 66-vector notation
+!> @brief rotated elasticity matrices for twinning in 6x6-matrix notation
 !--------------------------------------------------------------------------------------------------
 function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
 
@@ -505,6 +505,7 @@ function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
   type(rotation)                        :: R
   integer                               :: i
 
+
   select case(lattice)
     case('cF')
       coordinateSystem = buildCoordinateSystem(Ntwin,FCC_NSLIPSYSTEM,FCC_SYSTEMTWIN,&
@@ -521,14 +522,14 @@ function lattice_C66_twin(Ntwin,C66,lattice,CoverA)
 
   do i = 1, sum(Ntwin)
     call R%fromAxisAngle([coordinateSystem(1:3,2,i),PI],P=1)                                        ! ToDo: Why always 180 deg?
-    lattice_C66_twin(1:6,1:6,i) = R%rotTensor4sym(C66)
+    lattice_C66_twin(1:6,1:6,i) = math_3333toVoigt66(R%rotTensor4(math_Voigt66to3333(C66)))
   enddo
 
 end function lattice_C66_twin
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Rotated elasticity matrices for transformation in 66-vector notation
+!> @brief rotated elasticity matrices for transformation in 6x6-matrix notation
 !--------------------------------------------------------------------------------------------------
 function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
                            cOverA_trans,a_bcc,a_fcc)
@@ -571,23 +572,23 @@ function lattice_C66_trans(Ntrans,C_parent66,lattice_target, &
     call IO_error(137,ext_msg='lattice_C66_trans : '//trim(lattice_target))
   endif
 
-  do i = 1, 6
+  do i = 1,6
     if (abs(C_target_unrotated66(i,i))<tol_math_check) &
     call IO_error(135,el=i,ext_msg='matrix diagonal "el"ement in transformation')
   enddo
 
   call buildTransformationSystem(Q,S,Ntrans,cOverA_trans,a_fcc,a_bcc)
 
-  do i = 1, sum(Ntrans)
+  do i = 1,sum(Ntrans)
     call R%fromMatrix(Q(1:3,1:3,i))
-    lattice_C66_trans(1:6,1:6,i) = R%rotTensor4sym(C_target_unrotated66)
+    lattice_C66_trans(1:6,1:6,i) = math_3333toVoigt66(R%rotTensor4(math_Voigt66to3333(C_target_unrotated66)))
   enddo
 
  end function lattice_C66_trans
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Non-schmid projections for bcc with up to 6 coefficients
+!> @brief non-Schmid projections for bcc with up to 6 coefficients
 ! Koester et al. 2012, Acta Materialia 60 (2012) 3894–3901, eq. (17)
 ! Gröger et al. 2008, Acta Materialia 56 (2008) 5412–5425, table 1
 !--------------------------------------------------------------------------------------------------
@@ -634,7 +635,7 @@ end function lattice_nonSchmidMatrix
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Slip-slip interaction matrix
+!> @brief slip-slip interaction matrix
 !> details only active slip systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_SlipBySlip(Nslip,interactionValues,lattice) result(interactionMatrix)
@@ -750,22 +751,23 @@ function lattice_interaction_SlipBySlip(Nslip,interactionValues,lattice) result(
 
   integer, dimension(HEX_NSLIP,HEX_NSLIP), parameter :: &
     HEX_INTERACTIONSLIPSLIP = reshape( [&
+    ! basal      prism      2. prism   1. pyr<a>           1. pyr<c+a>                           2. pyr<c+a>
        1, 2, 2,   3, 3, 3,   7, 7, 7,  13,13,13,13,13,13,  21,21,21,21,21,21,21,21,21,21,21,21,  31,31,31,31,31,31, & ! -----> acting (forest)
-       2, 1, 2,   3, 3, 3,   7, 7, 7,  13,13,13,13,13,13,  21,21,21,21,21,21,21,21,21,21,21,21,  31,31,31,31,31,31, & ! |
+       2, 1, 2,   3, 3, 3,   7, 7, 7,  13,13,13,13,13,13,  21,21,21,21,21,21,21,21,21,21,21,21,  31,31,31,31,31,31, & ! | basal
        2, 2, 1,   3, 3, 3,   7, 7, 7,  13,13,13,13,13,13,  21,21,21,21,21,21,21,21,21,21,21,21,  31,31,31,31,31,31, & ! |
                                                                                                                       ! v
        6, 6, 6,   4, 5, 5,   8, 8, 8,  14,14,14,14,14,14,  22,22,22,22,22,22,22,22,22,22,22,22,  32,32,32,32,32,32, & ! reacting (primary)
-       6, 6, 6,   5, 4, 5,   8, 8, 8,  14,14,14,14,14,14,  22,22,22,22,22,22,22,22,22,22,22,22,  32,32,32,32,32,32, &
+       6, 6, 6,   5, 4, 5,   8, 8, 8,  14,14,14,14,14,14,  22,22,22,22,22,22,22,22,22,22,22,22,  32,32,32,32,32,32, & ! prism
        6, 6, 6,   5, 5, 4,   8, 8, 8,  14,14,14,14,14,14,  22,22,22,22,22,22,22,22,22,22,22,22,  32,32,32,32,32,32, &
 
       12,12,12,  11,11,11,   9,10,10,  15,15,15,15,15,15,  23,23,23,23,23,23,23,23,23,23,23,23,  33,33,33,33,33,33, &
-      12,12,12,  11,11,11,  10, 9,10,  15,15,15,15,15,15,  23,23,23,23,23,23,23,23,23,23,23,23,  33,33,33,33,33,33, &
+      12,12,12,  11,11,11,  10, 9,10,  15,15,15,15,15,15,  23,23,23,23,23,23,23,23,23,23,23,23,  33,33,33,33,33,33, & ! 2. prism
       12,12,12,  11,11,11,  10,10, 9,  15,15,15,15,15,15,  23,23,23,23,23,23,23,23,23,23,23,23,  33,33,33,33,33,33, &
 
       20,20,20,  19,19,19,  18,18,18,  16,17,17,17,17,17,  24,24,24,24,24,24,24,24,24,24,24,24,  34,34,34,34,34,34, &
       20,20,20,  19,19,19,  18,18,18,  17,16,17,17,17,17,  24,24,24,24,24,24,24,24,24,24,24,24,  34,34,34,34,34,34, &
       20,20,20,  19,19,19,  18,18,18,  17,17,16,17,17,17,  24,24,24,24,24,24,24,24,24,24,24,24,  34,34,34,34,34,34, &
-      20,20,20,  19,19,19,  18,18,18,  17,17,17,16,17,17,  24,24,24,24,24,24,24,24,24,24,24,24,  34,34,34,34,34,34, &
+      20,20,20,  19,19,19,  18,18,18,  17,17,17,16,17,17,  24,24,24,24,24,24,24,24,24,24,24,24,  34,34,34,34,34,34, & ! 1. pyr<a>
       20,20,20,  19,19,19,  18,18,18,  17,17,17,17,16,17,  24,24,24,24,24,24,24,24,24,24,24,24,  34,34,34,34,34,34, &
       20,20,20,  19,19,19,  18,18,18,  17,17,17,17,17,16,  24,24,24,24,24,24,24,24,24,24,24,24,  34,34,34,34,34,34, &
 
@@ -775,7 +777,7 @@ function lattice_interaction_SlipBySlip(Nslip,interactionValues,lattice) result(
       30,30,30,  29,29,29,  28,28,28,  27,27,27,27,27,27,  26,26,26,25,26,26,26,26,26,26,26,26,  35,35,35,35,35,35, &
       30,30,30,  29,29,29,  28,28,28,  27,27,27,27,27,27,  26,26,26,26,25,26,26,26,26,26,26,26,  35,35,35,35,35,35, &
       30,30,30,  29,29,29,  28,28,28,  27,27,27,27,27,27,  26,26,26,26,26,25,26,26,26,26,26,26,  35,35,35,35,35,35, &
-      30,30,30,  29,29,29,  28,28,28,  27,27,27,27,27,27,  26,26,26,26,26,26,25,26,26,26,26,26,  35,35,35,35,35,35, &
+      30,30,30,  29,29,29,  28,28,28,  27,27,27,27,27,27,  26,26,26,26,26,26,25,26,26,26,26,26,  35,35,35,35,35,35, & ! 1. pyr<c+a>
       30,30,30,  29,29,29,  28,28,28,  27,27,27,27,27,27,  26,26,26,26,26,26,26,25,26,26,26,26,  35,35,35,35,35,35, &
       30,30,30,  29,29,29,  28,28,28,  27,27,27,27,27,27,  26,26,26,26,26,26,26,26,25,26,26,26,  35,35,35,35,35,35, &
       30,30,30,  29,29,29,  28,28,28,  27,27,27,27,27,27,  26,26,26,26,26,26,26,26,26,25,26,26,  35,35,35,35,35,35, &
@@ -785,7 +787,7 @@ function lattice_interaction_SlipBySlip(Nslip,interactionValues,lattice) result(
       42,42,42,  41,41,41,  40,40,40,  39,39,39,39,39,39,  38,38,38,38,38,38,38,38,38,38,38,38,  36,37,37,37,37,37, &
       42,42,42,  41,41,41,  40,40,40,  39,39,39,39,39,39,  38,38,38,38,38,38,38,38,38,38,38,38,  37,36,37,37,37,37, &
       42,42,42,  41,41,41,  40,40,40,  39,39,39,39,39,39,  38,38,38,38,38,38,38,38,38,38,38,38,  37,37,36,37,37,37, &
-      42,42,42,  41,41,41,  40,40,40,  39,39,39,39,39,39,  38,38,38,38,38,38,38,38,38,38,38,38,  37,37,37,36,37,37, &
+      42,42,42,  41,41,41,  40,40,40,  39,39,39,39,39,39,  38,38,38,38,38,38,38,38,38,38,38,38,  37,37,37,36,37,37, & ! 2. pyr<c+a>
       42,42,42,  41,41,41,  40,40,40,  39,39,39,39,39,39,  38,38,38,38,38,38,38,38,38,38,38,38,  37,37,37,37,36,37, &
       42,42,42,  41,41,41,  40,40,40,  39,39,39,39,39,39,  38,38,38,38,38,38,38,38,38,38,38,38,  37,37,37,37,37,36  &
       ],shape(HEX_INTERACTIONSLIPSLIP))                                                             !< Slip-slip interaction types for hex (onion peel naming scheme)
@@ -882,7 +884,7 @@ end function lattice_interaction_SlipBySlip
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Twin-twin interaction matrix
+!> @brief twin-twin interaction matrix
 !> details only active twin systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_TwinByTwin(Ntwin,interactionValues,lattice) result(interactionMatrix)
@@ -931,31 +933,32 @@ function lattice_interaction_TwinByTwin(Ntwin,interactionValues,lattice) result(
                                                                                                     !< 3: other interaction
   integer, dimension(HEX_NTWIN,HEX_NTWIN), parameter :: &
     HEX_INTERACTIONTWINTWIN = reshape( [&
+    ! <-10.1>{10.2}       <11.6>{-1-1.1}      <10.-2>{10.1}       <11.-3>{11.2}
        1, 2, 2, 2, 2, 2,   3, 3, 3, 3, 3, 3,   7, 7, 7, 7, 7, 7,  13,13,13,13,13,13, & ! -----> acting
        2, 1, 2, 2, 2, 2,   3, 3, 3, 3, 3, 3,   7, 7, 7, 7, 7, 7,  13,13,13,13,13,13, & ! |
        2, 2, 1, 2, 2, 2,   3, 3, 3, 3, 3, 3,   7, 7, 7, 7, 7, 7,  13,13,13,13,13,13, & ! |
-       2, 2, 2, 1, 2, 2,   3, 3, 3, 3, 3, 3,   7, 7, 7, 7, 7, 7,  13,13,13,13,13,13, & ! v
+       2, 2, 2, 1, 2, 2,   3, 3, 3, 3, 3, 3,   7, 7, 7, 7, 7, 7,  13,13,13,13,13,13, & ! v <-10.1>{10.2}
        2, 2, 2, 2, 1, 2,   3, 3, 3, 3, 3, 3,   7, 7, 7, 7, 7, 7,  13,13,13,13,13,13, & ! reacting
        2, 2, 2, 2, 2, 1,   3, 3, 3, 3, 3, 3,   7, 7, 7, 7, 7, 7,  13,13,13,13,13,13, &
 
        6, 6, 6, 6, 6, 6,   4, 5, 5, 5, 5, 5,   8, 8, 8, 8, 8, 8,  14,14,14,14,14,14, &
        6, 6, 6, 6, 6, 6,   5, 4, 5, 5, 5, 5,   8, 8, 8, 8, 8, 8,  14,14,14,14,14,14, &
        6, 6, 6, 6, 6, 6,   5, 5, 4, 5, 5, 5,   8, 8, 8, 8, 8, 8,  14,14,14,14,14,14, &
-       6, 6, 6, 6, 6, 6,   5, 5, 5, 4, 5, 5,   8, 8, 8, 8, 8, 8,  14,14,14,14,14,14, &
+       6, 6, 6, 6, 6, 6,   5, 5, 5, 4, 5, 5,   8, 8, 8, 8, 8, 8,  14,14,14,14,14,14, & ! <11.6>{-1-1.1}
        6, 6, 6, 6, 6, 6,   5, 5, 5, 5, 4, 5,   8, 8, 8, 8, 8, 8,  14,14,14,14,14,14, &
        6, 6, 6, 6, 6, 6,   5, 5, 5, 5, 5, 4,   8, 8, 8, 8, 8, 8,  14,14,14,14,14,14, &
 
       12,12,12,12,12,12,  11,11,11,11,11,11,   9,10,10,10,10,10,  15,15,15,15,15,15, &
       12,12,12,12,12,12,  11,11,11,11,11,11,  10, 9,10,10,10,10,  15,15,15,15,15,15, &
       12,12,12,12,12,12,  11,11,11,11,11,11,  10,10, 9,10,10,10,  15,15,15,15,15,15, &
-      12,12,12,12,12,12,  11,11,11,11,11,11,  10,10,10, 9,10,10,  15,15,15,15,15,15, &
+      12,12,12,12,12,12,  11,11,11,11,11,11,  10,10,10, 9,10,10,  15,15,15,15,15,15, & ! <10.-2>{10.1}
       12,12,12,12,12,12,  11,11,11,11,11,11,  10,10,10,10, 9,10,  15,15,15,15,15,15, &
       12,12,12,12,12,12,  11,11,11,11,11,11,  10,10,10,10,10, 9,  15,15,15,15,15,15, &
 
       20,20,20,20,20,20,  19,19,19,19,19,19,  18,18,18,18,18,18,  16,17,17,17,17,17, &
       20,20,20,20,20,20,  19,19,19,19,19,19,  18,18,18,18,18,18,  17,16,17,17,17,17, &
       20,20,20,20,20,20,  19,19,19,19,19,19,  18,18,18,18,18,18,  17,17,16,17,17,17, &
-      20,20,20,20,20,20,  19,19,19,19,19,19,  18,18,18,18,18,18,  17,17,17,16,17,17, &
+      20,20,20,20,20,20,  19,19,19,19,19,19,  18,18,18,18,18,18,  17,17,17,16,17,17, & ! <11.-3>{11.2}
       20,20,20,20,20,20,  19,19,19,19,19,19,  18,18,18,18,18,18,  17,17,17,17,16,17, &
       20,20,20,20,20,20,  19,19,19,19,19,19,  18,18,18,18,18,18,  17,17,17,17,17,16  &
       ],shape(HEX_INTERACTIONTWINTWIN))                                                             !< Twin-twin interaction types for hex
@@ -980,7 +983,7 @@ end function lattice_interaction_TwinByTwin
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Trans-trans interaction matrix
+!> @brief trans-trans interaction matrix
 !> details only active trans systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_TransByTrans(Ntrans,interactionValues,lattice) result(interactionMatrix)
@@ -1009,7 +1012,7 @@ function lattice_interaction_TransByTrans(Ntrans,interactionValues,lattice) resu
       2,2,2,2,2,2,2,2,2,1,1,1  &
       ],shape(FCC_INTERACTIONTRANSTRANS))                                                           !< Trans-trans interaction types for fcc
 
-  if(lattice == 'cF') then
+  if (lattice == 'cF') then
     interactionTypes = FCC_INTERACTIONTRANSTRANS
     NtransMax        = FCC_NTRANSSYSTEM
   else
@@ -1022,7 +1025,7 @@ end function lattice_interaction_TransByTrans
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Slip-twin interaction matrix
+!> @brief slip-twin interaction matrix
 !> details only active slip and twin systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,lattice) result(interactionMatrix)
@@ -1122,22 +1125,23 @@ function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,lattice) r
 
   integer, dimension(HEX_NTWIN,HEX_NSLIP), parameter :: &
     HEX_INTERACTIONSLIPTWIN = reshape( [&
+    ! <-10.1>{10.2}       <11.6>{-1-1.1}      <10.-2>{10.1}       <11.-3>{11.2}
        1, 1, 1, 1, 1, 1,   2, 2, 2, 2, 2, 2,   3, 3, 3, 3, 3, 3,   4, 4, 4, 4, 4, 4, & ! ----> twin (acting)
-       1, 1, 1, 1, 1, 1,   2, 2, 2, 2, 2, 2,   3, 3, 3, 3, 3, 3,   4, 4, 4, 4, 4, 4, & ! |
+       1, 1, 1, 1, 1, 1,   2, 2, 2, 2, 2, 2,   3, 3, 3, 3, 3, 3,   4, 4, 4, 4, 4, 4, & ! | basal
        1, 1, 1, 1, 1, 1,   2, 2, 2, 2, 2, 2,   3, 3, 3, 3, 3, 3,   4, 4, 4, 4, 4, 4, & ! |
                                                                                        ! v
        5, 5, 5, 5, 5, 5,   6, 6, 6, 6, 6, 6,   7, 7, 7, 7, 7, 7,   8, 8, 8, 8, 8, 8, & ! slip (reacting)
-       5, 5, 5, 5, 5, 5,   6, 6, 6, 6, 6, 6,   7, 7, 7, 7, 7, 7,   8, 8, 8, 8, 8, 8, &
+       5, 5, 5, 5, 5, 5,   6, 6, 6, 6, 6, 6,   7, 7, 7, 7, 7, 7,   8, 8, 8, 8, 8, 8, & ! prism
        5, 5, 5, 5, 5, 5,   6, 6, 6, 6, 6, 6,   7, 7, 7, 7, 7, 7,   8, 8, 8, 8, 8, 8, &
 
        9, 9, 9, 9, 9, 9,  10,10,10,10,10,10,  11,11,11,11,11,11,  12,12,12,12,12,12, &
-       9, 9, 9, 9, 9, 9,  10,10,10,10,10,10,  11,11,11,11,11,11,  12,12,12,12,12,12, &
+       9, 9, 9, 9, 9, 9,  10,10,10,10,10,10,  11,11,11,11,11,11,  12,12,12,12,12,12, & ! 2.prism
        9, 9, 9, 9, 9, 9,  10,10,10,10,10,10,  11,11,11,11,11,11,  12,12,12,12,12,12, &
 
       13,13,13,13,13,13,  14,14,14,14,14,14,  15,15,15,15,15,15,  16,16,16,16,16,16, &
       13,13,13,13,13,13,  14,14,14,14,14,14,  15,15,15,15,15,15,  16,16,16,16,16,16, &
       13,13,13,13,13,13,  14,14,14,14,14,14,  15,15,15,15,15,15,  16,16,16,16,16,16, &
-      13,13,13,13,13,13,  14,14,14,14,14,14,  15,15,15,15,15,15,  16,16,16,16,16,16, &
+      13,13,13,13,13,13,  14,14,14,14,14,14,  15,15,15,15,15,15,  16,16,16,16,16,16, & ! 1. pyr<a>
       13,13,13,13,13,13,  14,14,14,14,14,14,  15,15,15,15,15,15,  16,16,16,16,16,16, &
       13,13,13,13,13,13,  14,14,14,14,14,14,  15,15,15,15,15,15,  16,16,16,16,16,16, &
 
@@ -1147,7 +1151,7 @@ function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,lattice) r
       17,17,17,17,17,17,  18,18,18,18,18,18,  19,19,19,19,19,19,  20,20,20,20,20,20, &
       17,17,17,17,17,17,  18,18,18,18,18,18,  19,19,19,19,19,19,  20,20,20,20,20,20, &
       17,17,17,17,17,17,  18,18,18,18,18,18,  19,19,19,19,19,19,  20,20,20,20,20,20, &
-      17,17,17,17,17,17,  18,18,18,18,18,18,  19,19,19,19,19,19,  20,20,20,20,20,20, &
+      17,17,17,17,17,17,  18,18,18,18,18,18,  19,19,19,19,19,19,  20,20,20,20,20,20, & ! 1. pyr<c+a>
       17,17,17,17,17,17,  18,18,18,18,18,18,  19,19,19,19,19,19,  20,20,20,20,20,20, &
       17,17,17,17,17,17,  18,18,18,18,18,18,  19,19,19,19,19,19,  20,20,20,20,20,20, &
       17,17,17,17,17,17,  18,18,18,18,18,18,  19,19,19,19,19,19,  20,20,20,20,20,20, &
@@ -1157,7 +1161,7 @@ function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,lattice) r
       21,21,21,21,21,21,  22,22,22,22,22,22,  23,23,23,23,23,23,  24,24,24,24,24,24, &
       21,21,21,21,21,21,  22,22,22,22,22,22,  23,23,23,23,23,23,  24,24,24,24,24,24, &
       21,21,21,21,21,21,  22,22,22,22,22,22,  23,23,23,23,23,23,  24,24,24,24,24,24, &
-      21,21,21,21,21,21,  22,22,22,22,22,22,  23,23,23,23,23,23,  24,24,24,24,24,24, &
+      21,21,21,21,21,21,  22,22,22,22,22,22,  23,23,23,23,23,23,  24,24,24,24,24,24, & ! 2. pyr<c+a>
       21,21,21,21,21,21,  22,22,22,22,22,22,  23,23,23,23,23,23,  24,24,24,24,24,24, &
       21,21,21,21,21,21,  22,22,22,22,22,22,  23,23,23,23,23,23,  24,24,24,24,24,24  &
       ],shape(HEX_INTERACTIONSLIPTWIN))                                                             !< Slip-twin interaction types for hex
@@ -1185,7 +1189,7 @@ end function lattice_interaction_SlipByTwin
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Slip-trans interaction matrix
+!> @brief slip-trans interaction matrix
 !> details only active slip and trans systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,lattice) result(interactionMatrix)
@@ -1238,7 +1242,7 @@ function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,lattice)
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Twin-slip interaction matrix
+!> @brief twin-slip interaction matrix
 !> details only active twin and slip systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,lattice) result(interactionMatrix)
@@ -1261,31 +1265,32 @@ function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,lattice) r
 
   integer, dimension(HEX_NSLIP,HEX_NTWIN), parameter :: &
     HEX_INTERACTIONTWINSLIP = reshape( [&
+    ! basal      prism     2. prism   1. pyr<a>           1. pyr<c+a>                           2. pyr<c+a>
       1, 1, 1,   5, 5, 5,   9, 9, 9,  13,13,13,13,13,13,  17,17,17,17,17,17,17,17,17,17,17,17,  21,21,21,21,21,21, & ! ----> slip (acting)
       1, 1, 1,   5, 5, 5,   9, 9, 9,  13,13,13,13,13,13,  17,17,17,17,17,17,17,17,17,17,17,17,  21,21,21,21,21,21, & ! |
       1, 1, 1,   5, 5, 5,   9, 9, 9,  13,13,13,13,13,13,  17,17,17,17,17,17,17,17,17,17,17,17,  21,21,21,21,21,21, & ! |
-      1, 1, 1,   5, 5, 5,   9, 9, 9,  13,13,13,13,13,13,  17,17,17,17,17,17,17,17,17,17,17,17,  21,21,21,21,21,21, & ! v
+      1, 1, 1,   5, 5, 5,   9, 9, 9,  13,13,13,13,13,13,  17,17,17,17,17,17,17,17,17,17,17,17,  21,21,21,21,21,21, & ! v <-10.1>{10.2}
       1, 1, 1,   5, 5, 5,   9, 9, 9,  13,13,13,13,13,13,  17,17,17,17,17,17,17,17,17,17,17,17,  21,21,21,21,21,21, & ! twin (reacting)
       1, 1, 1,   5, 5, 5,   9, 9, 9,  13,13,13,13,13,13,  17,17,17,17,17,17,17,17,17,17,17,17,  21,21,21,21,21,21, &
 
       2, 2, 2,   6, 6, 6,  10,10,10,  14,14,14,14,14,14,  18,18,18,18,18,18,18,18,18,18,18,18,  22,22,22,22,22,22, &
       2, 2, 2,   6, 6, 6,  10,10,10,  14,14,14,14,14,14,  18,18,18,18,18,18,18,18,18,18,18,18,  22,22,22,22,22,22, &
       2, 2, 2,   6, 6, 6,  10,10,10,  14,14,14,14,14,14,  18,18,18,18,18,18,18,18,18,18,18,18,  22,22,22,22,22,22, &
-      2, 2, 2,   6, 6, 6,  10,10,10,  14,14,14,14,14,14,  18,18,18,18,18,18,18,18,18,18,18,18,  22,22,22,22,22,22, &
+      2, 2, 2,   6, 6, 6,  10,10,10,  14,14,14,14,14,14,  18,18,18,18,18,18,18,18,18,18,18,18,  22,22,22,22,22,22, & ! <11.6>{-1-1.1}
       2, 2, 2,   6, 6, 6,  10,10,10,  14,14,14,14,14,14,  18,18,18,18,18,18,18,18,18,18,18,18,  22,22,22,22,22,22, &
       2, 2, 2,   6, 6, 6,  10,10,10,  14,14,14,14,14,14,  18,18,18,18,18,18,18,18,18,18,18,18,  22,22,22,22,22,22, &
 
       3, 3, 3,   7, 7, 7,  11,11,11,  15,15,15,15,15,15,  19,19,19,19,19,19,19,19,19,19,19,19,  23,23,23,23,23,23, &
       3, 3, 3,   7, 7, 7,  11,11,11,  15,15,15,15,15,15,  19,19,19,19,19,19,19,19,19,19,19,19,  23,23,23,23,23,23, &
       3, 3, 3,   7, 7, 7,  11,11,11,  15,15,15,15,15,15,  19,19,19,19,19,19,19,19,19,19,19,19,  23,23,23,23,23,23, &
-      3, 3, 3,   7, 7, 7,  11,11,11,  15,15,15,15,15,15,  19,19,19,19,19,19,19,19,19,19,19,19,  23,23,23,23,23,23, &
+      3, 3, 3,   7, 7, 7,  11,11,11,  15,15,15,15,15,15,  19,19,19,19,19,19,19,19,19,19,19,19,  23,23,23,23,23,23, & ! <10.-2>{10.1}
       3, 3, 3,   7, 7, 7,  11,11,11,  15,15,15,15,15,15,  19,19,19,19,19,19,19,19,19,19,19,19,  23,23,23,23,23,23, &
       3, 3, 3,   7, 7, 7,  11,11,11,  15,15,15,15,15,15,  19,19,19,19,19,19,19,19,19,19,19,19,  23,23,23,23,23,23, &
 
       4, 4, 4,   8, 8, 8,  12,12,12,  16,16,16,16,16,16,  20,20,20,20,20,20,20,20,20,20,20,20,  24,24,24,24,24,24, &
       4, 4, 4,   8, 8, 8,  12,12,12,  16,16,16,16,16,16,  20,20,20,20,20,20,20,20,20,20,20,20,  24,24,24,24,24,24, &
       4, 4, 4,   8, 8, 8,  12,12,12,  16,16,16,16,16,16,  20,20,20,20,20,20,20,20,20,20,20,20,  24,24,24,24,24,24, &
-      4, 4, 4,   8, 8, 8,  12,12,12,  16,16,16,16,16,16,  20,20,20,20,20,20,20,20,20,20,20,20,  24,24,24,24,24,24, &
+      4, 4, 4,   8, 8, 8,  12,12,12,  16,16,16,16,16,16,  20,20,20,20,20,20,20,20,20,20,20,20,  24,24,24,24,24,24, & ! <11.-3>{11.2}
       4, 4, 4,   8, 8, 8,  12,12,12,  16,16,16,16,16,16,  20,20,20,20,20,20,20,20,20,20,20,20,  24,24,24,24,24,24, &
       4, 4, 4,   8, 8, 8,  12,12,12,  16,16,16,16,16,16,  20,20,20,20,20,20,20,20,20,20,20,20,  24,24,24,24,24,24  &
       ],shape(HEX_INTERACTIONTWINSLIP))                                                             !< Twin-slip interaction types for hex
@@ -1410,7 +1415,7 @@ end function lattice_SchmidMatrix_twin
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Schmid matrix for twinning
+!> @brief Schmid matrix for transformation
 !> details only active twin systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_SchmidMatrix_trans(Ntrans,lattice_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix)
@@ -1482,7 +1487,7 @@ end function lattice_SchmidMatrix_cleavage
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Slip direction of slip systems (|| b)
+!> @brief slip direction of slip systems (|| b)
 !--------------------------------------------------------------------------------------------------
 function lattice_slip_direction(Nslip,lattice,cOverA) result(d)
 
@@ -1500,7 +1505,7 @@ end function lattice_slip_direction
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Normal direction of slip systems (|| n)
+!> @brief normal direction of slip systems (|| n)
 !--------------------------------------------------------------------------------------------------
 function lattice_slip_normal(Nslip,lattice,cOverA) result(n)
 
@@ -1518,7 +1523,7 @@ end function lattice_slip_normal
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Transverse direction of slip systems (|| t = b x n)
+!> @brief transverse direction of slip systems (|| t = b x n)
 !--------------------------------------------------------------------------------------------------
 function lattice_slip_transverse(Nslip,lattice,cOverA) result(t)
 
@@ -1536,7 +1541,7 @@ end function lattice_slip_transverse
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Labels for slip systems
+!> @brief labels of slip systems
 !> details only active slip systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_labels_slip(Nslip,lattice) result(labels)
@@ -1577,7 +1582,7 @@ end function lattice_labels_slip
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Return 3x3 tensor with symmetry according to given Bravais lattice
+!> @brief return 3x3 tensor with symmetry according to given Bravais lattice
 !--------------------------------------------------------------------------------------------------
 pure function lattice_symmetrize_33(T,lattice) result(T_sym)
 
@@ -1604,7 +1609,7 @@ end function lattice_symmetrize_33
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Return stiffness matrix in 6x6 notation with symmetry according to given Bravais lattice
+!> @brief return stiffness matrix in 6x6 notation with symmetry according to given Bravais lattice
 !> @details J. A. Rayne and B. S. Chandrasekhar Phys. Rev. 120, 1658 Erratum Phys. Rev. 122, 1962
 !--------------------------------------------------------------------------------------------------
 pure function lattice_symmetrize_C66(C66,lattice) result(C66_sym)
@@ -1650,7 +1655,7 @@ end function lattice_symmetrize_C66
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Labels for twin systems
+!> @brief labels of twin systems
 !> details only active twin systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_labels_twin(Ntwin,lattice) result(labels)
@@ -1688,7 +1693,7 @@ end function lattice_labels_twin
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Projection of the transverse direction onto the slip plane
+!> @brief projection of the transverse direction onto the slip plane
 !> @details: This projection is used to calculate forest hardening for edge dislocations
 !--------------------------------------------------------------------------------------------------
 function slipProjection_transverse(Nslip,lattice,cOverA) result(projection)
@@ -1712,7 +1717,7 @@ end function slipProjection_transverse
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Projection of the slip direction onto the slip plane
+!> @brief projection of the slip direction onto the slip plane
 !> @details: This projection is used to calculate forest hardening for screw dislocations
 !--------------------------------------------------------------------------------------------------
 function slipProjection_direction(Nslip,lattice,cOverA) result(projection)
@@ -1778,7 +1783,7 @@ end function coordinateSystem_slip
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Populate reduced interaction matrix
+!> @brief populate reduced interaction matrix
 !--------------------------------------------------------------------------------------------------
 function buildInteraction(reacting_used,acting_used,reacting_max,acting_max,values,matrix)
 
@@ -1821,7 +1826,7 @@ end function buildInteraction
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Build a local coordinate system on slip, twin, trans, cleavage systems
+!> @brief build a local coordinate system on slip, twin, trans, cleavage systems
 !> @details Order: Direction, plane (normal), and common perpendicular
 !--------------------------------------------------------------------------------------------------
 function buildCoordinateSystem(active,potential,system,lattice,cOverA)
@@ -1888,7 +1893,7 @@ end function buildCoordinateSystem
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Helper function to define transformation systems
+!> @brief helper function to define transformation systems
 ! Needed to calculate Schmid matrix and rotated stiffness matrices.
 ! @details: set c/a   = 0.0 for fcc -> bcc transformation
 !           set a_Xcc = 0.0 for fcc -> hex transformation
@@ -2072,7 +2077,7 @@ end function getlabels
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Equivalent Poisson's ratio (ν)
+!> @brief equivalent Poisson's ratio (ν)
 !> @details https://doi.org/10.1143/JPSJ.20.635
 !--------------------------------------------------------------------------------------------------
 function lattice_equivalent_nu(C,assumption) result(nu)
@@ -2086,12 +2091,12 @@ function lattice_equivalent_nu(C,assumption) result(nu)
   real(pReal), dimension(6,6) :: S
 
 
-  if    (IO_lc(assumption) == 'voigt') then
+  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
-  elseif(IO_lc(assumption) == 'reuss') then
+  elseif (IO_lc(assumption) == 'reuss') then
     call math_invert(S,error,C)
-    if(error) error stop 'matrix inversion failed'
+    if (error) error stop 'matrix inversion failed'
     K = 1.0_pReal &
       / (S(1,1)+S(2,2)+S(3,3) +2.0_pReal*(S(1,2)+S(2,3)+S(1,3)))
   else
@@ -2099,13 +2104,13 @@ function lattice_equivalent_nu(C,assumption) result(nu)
   endif
 
   mu = lattice_equivalent_mu(C,assumption)
-  nu = (1.5_pReal*K -mu)/(3.0_pReal*K+mu)
+  nu = (1.5_pReal*K-mu)/(3.0_pReal*K+mu)
 
 end function lattice_equivalent_nu
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Equivalent shear modulus (μ)
+!> @brief equivalent shear modulus (μ)
 !> @details https://doi.org/10.1143/JPSJ.20.635
 !--------------------------------------------------------------------------------------------------
 function lattice_equivalent_mu(C,assumption) result(mu)
@@ -2118,12 +2123,12 @@ function lattice_equivalent_mu(C,assumption) result(mu)
   real(pReal), dimension(6,6) :: S
 
 
-  if    (IO_lc(assumption) == 'voigt') then
+  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
-  elseif(IO_lc(assumption) == 'reuss') then
+  elseif (IO_lc(assumption) == 'reuss') then
     call math_invert(S,error,C)
-    if(error) error stop 'matrix inversion failed'
+    if (error) error stop 'matrix inversion failed'
     mu = 15.0_pReal &
        / (4.0_pReal*(S(1,1)+S(2,2)+S(3,3)) -4.0_pReal*(S(1,2)+S(2,3)+S(1,3)) +3.0_pReal*(S(4,4)+S(5,5)+S(6,6)))
   else
@@ -2134,7 +2139,7 @@ end function lattice_equivalent_mu
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief Check correctness of some lattice functions.
+!> @brief check correctness of some lattice functions
 !--------------------------------------------------------------------------------------------------
 subroutine selfTest
 
@@ -2152,7 +2157,7 @@ subroutine selfTest
 
   system = reshape([1.0_pReal+r(1),0.0_pReal,0.0_pReal, 0.0_pReal,1.0_pReal+r(2),0.0_pReal],[6,1])
   CoSy   = buildCoordinateSystem([1],[1],system,'cF',0.0_pReal)
-  if(any(dNeq(CoSy(1:3,1:3,1),math_I3))) error stop 'buildCoordinateSystem'
+  if (any(dNeq(CoSy(1:3,1:3,1),math_I3))) error stop 'buildCoordinateSystem'
 
   do i = 1, 10
     call random_number(C)
@@ -2198,13 +2203,13 @@ subroutine selfTest
   C(1,1) = C(1,1) + C(1,2) + 0.1_pReal
   C(4,4) = 0.5_pReal * (C(1,1) - C(1,2))
   C = lattice_symmetrize_C66(C,'cI')
-  if(dNeq(C(4,4),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt'
+  if (dNeq(C(4,4),lattice_equivalent_mu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_mu/voigt'
-  if(dNeq(C(4,4),lattice_equivalent_mu(C,'reuss'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss'
+  if (dNeq(C(4,4),lattice_equivalent_mu(C,'reuss'),1.0e-12_pReal)) error stop 'equivalent_mu/reuss'
 
   lambda = C(1,2)
-  if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'voigt')), &
+  if (dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'voigt')), &
           lattice_equivalent_nu(C,'voigt'),1.0e-12_pReal)) error stop 'equivalent_nu/voigt'
-  if(dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'reuss')), &
+  if (dNeq(lambda*0.5_pReal/(lambda+lattice_equivalent_mu(C,'reuss')), &
           lattice_equivalent_nu(C,'reuss'),1.0e-12_pReal)) error stop 'equivalent_nu/reuss'
 
 end subroutine selfTest

src/material.f90

@@ -26,6 +26,7 @@ module material
 
 
   type(tRotationContainer), dimension(:), allocatable :: material_O_0
+  type(tTensorContainer),   dimension(:), allocatable :: material_F_i_0
 
   integer, dimension(:), allocatable, public, protected :: &
     homogenization_Nconstituents                                                                    !< number of grains in each homogenization
@@ -48,6 +49,7 @@ module material
   public :: &
     tTensorContainer, &
     tRotationContainer, &
+    material_F_i_0, &
     material_O_0, &
     material_init
 
@@ -61,11 +63,11 @@ subroutine material_init(restart)
   logical, intent(in) :: restart
 
 
-  print'(/,a)', ' <<<+-  material init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  material init  -+>>>'; flush(IO_STDOUT)
 
 
   call parse
-  print*, 'parsed material.yaml'
+  print'(/,1x,a)', 'parsed material.yaml'
 
 
   if (.not. restart) then
@@ -73,7 +75,7 @@ subroutine material_init(restart)
     call results_mapping_phase(material_phaseID,material_phaseEntry,material_name_phase)
     call results_mapping_homogenization(material_homogenizationID,material_homogenizationEntry,material_name_homogenization)
     call results_closeJobFile
-  endif
+  end if
 
 end subroutine material_init
 
@@ -113,7 +115,7 @@ subroutine parse()
   do h=1, homogenizations%length
     homogenization => homogenizations%get(h)
     homogenization_Nconstituents(h) = homogenization%get_asInt('N_constituents')
-  enddo
+  end do
   homogenization_maxNconstituents = maxval(homogenization_Nconstituents)
 
   allocate(counterPhase(phases%length),source=0)
@@ -137,7 +139,7 @@ subroutine parse()
       material_homogenizationID(ce) = homogenizations%getIndex(material%get_asString('homogenization'))
       counterHomogenization(material_homogenizationID(ce)) = counterHomogenization(material_homogenizationID(ce)) + 1
       material_homogenizationEntry(ce) = counterHomogenization(material_homogenizationID(ce))
-    enddo
+    end do
 
     frac = 0.0_pReal
     do co = 1, constituents%length
@@ -151,22 +153,25 @@ subroutine parse()
         material_phaseMemberAt(co,ip,el)      = counterPhase(material_phaseAt(co,el))
         material_phaseEntry(co,ce) = counterPhase(material_phaseAt(co,el))
         material_phaseID(co,ce) = material_phaseAt(co,el)
-      enddo
+      end do
 
-    enddo
+    end do
     if (dNeq(frac,1.0_pReal,1.e-12_pReal)) call IO_error(153,ext_msg='constituent')
 
-  enddo
+  end do
 
   allocate(material_O_0(materials%length))
+  allocate(material_F_i_0(materials%length))
 
   do ma = 1, materials%length
     material     => materials%get(ma)
     constituents => material%get('constituents')
     allocate(material_O_0(ma)%data(constituents%length))
+    allocate(material_F_i_0(ma)%data(1:3,1:3,constituents%length))
     do co = 1, constituents%length
       constituent => constituents%get(co)
       call material_O_0(ma)%data(co)%fromQuaternion(constituent%get_as1dFloat('O',requiredSize=4))
+      material_F_i_0(ma)%data(1:3,1:3,co) = constituent%get_as2dFloat('F_i',defaultVal=math_I3,requiredShape=[3,3])
     enddo
  enddo
 
@@ -186,15 +191,15 @@ subroutine sanityCheck(materials,homogenizations)
                            constituents
   integer :: m
 
-  if(maxval(discretization_materialAt) > materials%length) &
+  if (maxval(discretization_materialAt) > materials%length) &
     call IO_error(155,ext_msg='More materials requested than found in material.yaml')
 
   do m = 1, materials%length
     material => materials%get(m)
     constituents   => material%get('constituents')
     homogenization => homogenizations%get(material%get_asString('homogenization'))
-    if(constituents%length /= homogenization%get_asInt('N_constituents')) call IO_error(148)
+    if (constituents%length /= homogenization%get_asInt('N_constituents')) call IO_error(148)
-  enddo
+  end do
 
 end subroutine sanityCheck
 
@@ -215,12 +220,12 @@ function getKeys(dict)
   do i=1, dict%length
     temp(i) = dict%getKey(i)
     l = max(len_trim(temp(i)),l)
-  enddo
+  end do
 
   allocate(character(l)::getKeys(dict%length))
   do i=1, dict%length
     getKeys(i) = trim(temp(i))
-  enddo
+  end do
 
 end function getKeys
 

src/math.f90

@@ -15,15 +15,15 @@ module math
   implicit none
   public
 #if __INTEL_COMPILER >= 1900
-  ! do not make use associated entities available to other modules
+  ! do not make use of associated entities available to other modules
   private :: &
     IO, &
     config
 #endif
 
   real(pReal),    parameter :: PI = acos(-1.0_pReal)                                                !< ratio of a circle's circumference to its diameter
-  real(pReal),    parameter :: INDEG = 180.0_pReal/PI                                               !< conversion from radian into degree
+  real(pReal),    parameter :: INDEG = 180.0_pReal/PI                                               !< conversion from radian to degree
-  real(pReal),    parameter :: INRAD = PI/180.0_pReal                                               !< conversion from degree into radian
+  real(pReal),    parameter :: INRAD = PI/180.0_pReal                                               !< conversion from degree to radian
   complex(pReal), parameter :: TWOPIIMG = cmplx(0.0_pReal,2.0_pReal*PI)                             !< Re(0.0), Im(2xPi)
 
   real(pReal), dimension(3,3), parameter :: &
@@ -91,7 +91,7 @@ subroutine math_init
   class(tNode), pointer :: &
     num_generic
 
-  print'(/,a)', ' <<<+-  math init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  math init  -+>>>'; flush(IO_STDOUT)
 
   num_generic => config_numerics%get('generic',defaultVal=emptyDict)
   randomSeed  = num_generic%get_asInt('random_seed', defaultVal = 0)
@@ -109,9 +109,9 @@ subroutine math_init
   call random_seed(put = randInit)
   call random_number(randTest)
 
-  print'(a,i2)',                ' size  of random seed:     ', randSize
+  print'(/,a,i2)',                ' size  of random seed:     ', randSize
-  print'(a,i0)',                ' value of random seed:     ', randInit(1)
+  print'(  a,i0)',                ' value of random seed:     ', randInit(1)
-  print'(a,4(/,26x,f17.14),/)', ' start of random sequence: ', randTest
+  print'(  a,4(/,26x,f17.14),/)', ' start of random sequence: ', randTest
 
   call random_seed(put = randInit)
 
@@ -132,19 +132,19 @@ pure recursive subroutine math_sort(a, istart, iend, sortDim)
   integer, intent(in),optional :: istart,iend, sortDim
   integer :: ipivot,s,e,d
 
-  if(present(istart)) then
+  if (present(istart)) then
     s = istart
   else
     s = lbound(a,2)
   endif
 
-  if(present(iend)) then
+  if (present(iend)) then
     e = iend
   else
     e = ubound(a,2)
   endif
 
-  if(present(sortDim)) then
+  if (present(sortDim)) then
     d = sortDim
   else
     d = 1
@@ -467,7 +467,7 @@ pure function math_inv33(A)
   logical     :: error
 
   call math_invert33(math_inv33,DetA,error,A)
-  if(error) math_inv33 = 0.0_pReal
+  if (error) math_inv33 = 0.0_pReal
 
 end function math_inv33
 
@@ -698,7 +698,7 @@ pure function math_sym33to6(m33,weighted)
   integer :: i
 
 
-  if(present(weighted)) then
+  if (present(weighted)) then
     w = merge(NRMMANDEL,1.0_pReal,weighted)
   else
     w = NRMMANDEL
@@ -725,7 +725,7 @@ pure function math_6toSym33(v6,weighted)
   integer :: i
 
 
-  if(present(weighted)) then
+  if (present(weighted)) then
     w = merge(INVNRMMANDEL,1.0_pReal,weighted)
   else
     w = INVNRMMANDEL
@@ -802,7 +802,7 @@ pure function math_sym3333to66(m3333,weighted)
   integer :: i,j
 
 
-  if(present(weighted)) then
+  if (present(weighted)) then
     w = merge(NRMMANDEL,1.0_pReal,weighted)
   else
     w = NRMMANDEL
@@ -822,7 +822,7 @@ end function math_sym3333to66
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief convert 66 matrix into symmetric 3x3x3x3 matrix
+!> @brief convert 6x6 matrix into symmetric 3x3x3x3 matrix
 !> @details Weighted conversion (default) rearranges according to Nye and weights shear
 ! components according to Mandel. Advisable for matrix operations.
 ! Unweighted conversion only rearranges order according to Nye
@@ -837,7 +837,7 @@ pure function math_66toSym3333(m66,weighted)
   integer :: i,j
 
 
-  if(present(weighted)) then
+  if (present(weighted)) then
     w = merge(INVNRMMANDEL,1.0_pReal,weighted)
   else
     w = INVNRMMANDEL
@@ -854,12 +854,13 @@ end function math_66toSym3333
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief convert 66 Voigt matrix into symmetric 3x3x3x3 matrix
+!> @brief convert 6x6 Voigt matrix into symmetric 3x3x3x3 matrix
 !--------------------------------------------------------------------------------------------------
 pure function math_Voigt66to3333(m66)
 
   real(pReal), dimension(3,3,3,3) :: math_Voigt66to3333
   real(pReal), dimension(6,6), intent(in) :: m66                                                    !< 6x6 matrix
+
   integer :: i,j
 
 
@@ -873,6 +874,31 @@ pure function math_Voigt66to3333(m66)
 end function math_Voigt66to3333
 
 
+!--------------------------------------------------------------------------------------------------
+!> @brief convert symmetric 3x3x3x3 matrix into 6x6 Voigt matrix
+!--------------------------------------------------------------------------------------------------
+pure function math_3333toVoigt66(m3333)
+
+  real(pReal), dimension(6,6)                 :: math_3333toVoigt66
+  real(pReal), dimension(3,3,3,3), intent(in) :: m3333                                              !< symmetric 3x3x3x3 matrix (no internal check)
+
+  integer :: i,j
+
+
+#ifndef __INTEL_COMPILER
+  do concurrent(i=1:6, j=1:6)
+    math_3333toVoigt66(i,j) = m3333(MAPVOIGT(1,i),MAPVOIGT(2,i),MAPVOIGT(1,j),MAPVOIGT(2,j))
+  end do
+#else
+  do i=1,6; do j=1,6
+    math_3333toVoigt66(i,j) = m3333(MAPVOIGT(1,i),MAPVOIGT(2,i),MAPVOIGT(1,j),MAPVOIGT(2,j))
+  end do; end do
+#endif
+
+end function math_3333toVoigt66
+
+
+
 !--------------------------------------------------------------------------------------------------
 !> @brief draw a random sample from Gauss variable
 !--------------------------------------------------------------------------------------------------
@@ -958,7 +984,7 @@ subroutine math_eigh33(w,v,m)
                v(2,2) + m(2, 3) * w(1), &
               (m(1,1) - w(1)) * (m(2,2) - w(1)) - v(3,2)]
   norm = norm2(v(1:3, 1))
-  fallback1: if(norm < threshold) then
+  fallback1: if (norm < threshold) then
     call math_eigh(w,v,error,m)
   else fallback1
     v(1:3,1) = v(1:3, 1) / norm
@@ -966,7 +992,7 @@ subroutine math_eigh33(w,v,m)
                  v(2,2) + m(2, 3) * w(2), &
                 (m(1,1) - w(2)) * (m(2,2) - w(2)) - v(3,2)]
     norm = norm2(v(1:3, 2))
-    fallback2: if(norm < threshold) then
+    fallback2: if (norm < threshold) then
       call math_eigh(w,v,error,m)
     else fallback2
       v(1:3,2) = v(1:3, 2) / norm
@@ -1003,7 +1029,7 @@ pure function math_rotationalPart(F) result(R)
   I_F = [math_trace33(F), 0.5*(math_trace33(F)**2 - math_trace33(matmul(F,F)))]
 
   x = math_clip(I_C(1)**2 -3.0_pReal*I_C(2),0.0_pReal)**(3.0_pReal/2.0_pReal)
-  if(dNeq0(x)) then
+  if (dNeq0(x)) then
     Phi = acos(math_clip((I_C(1)**3 -4.5_pReal*I_C(1)*I_C(2) +13.5_pReal*I_C(3))/x,-1.0_pReal,1.0_pReal))
     lambda = I_C(1) +(2.0_pReal * sqrt(math_clip(I_C(1)**2-3.0_pReal*I_C(2),0.0_pReal))) &
                     *cos((Phi-2.0_pReal * PI*[1.0_pReal,2.0_pReal,3.0_pReal])/3.0_pReal)
@@ -1065,7 +1091,7 @@ function math_eigvalsh33(m)
     - 2.0_pReal/27.0_pReal*I(1)**3.0_pReal &
     - I(3)                                                                                          ! different from http://arxiv.org/abs/physics/0610206 (this formulation was in DAMASK)
 
-  if(all(abs([P,Q]) < TOL)) then
+  if (all(abs([P,Q]) < TOL)) then
     math_eigvalsh33 = math_eigvalsh(m)
   else
     rho=sqrt(-3.0_pReal*P**3.0_pReal)/9.0_pReal
@@ -1188,7 +1214,7 @@ real(pReal) pure elemental function math_clip(a, left, right)
   if (present(left))  math_clip = max(left,math_clip)
   if (present(right)) math_clip = min(right,math_clip)
   if (present(left) .and. present(right)) then
-    if(left>right) error stop 'left > right'
+    if (left>right) error stop 'left > right'
   endif
 
 end function math_clip
@@ -1234,35 +1260,38 @@ subroutine selfTest
     error stop 'math_expand [1,2] by [1,2,3] => [1,2,2,1,1,1]'
 
   call math_sort(sort_in_,1,3,2)
-  if(any(sort_in_ /= sort_out_)) &
+  if (any(sort_in_ /= sort_out_)) &
     error stop 'math_sort'
 
-  if(any(math_range(5) /= range_out_)) &
+  if (any(math_range(5) /= range_out_)) &
     error stop 'math_range'
 
-  if(any(dNeq(math_exp33(math_I3,0),math_I3))) &
+  if (any(dNeq(math_exp33(math_I3,0),math_I3))) &
     error stop 'math_exp33(math_I3,1)'
-  if(any(dNeq(math_exp33(math_I3,128),exp(1.0_pReal)*math_I3))) &
+  if (any(dNeq(math_exp33(math_I3,128),exp(1.0_pReal)*math_I3))) &
     error stop 'math_exp33(math_I3,128)'
 
   call random_number(v9)
-  if(any(dNeq(math_33to9(math_9to33(v9)),v9))) &
+  if (any(dNeq(math_33to9(math_9to33(v9)),v9))) &
     error stop 'math_33to9/math_9to33'
 
   call random_number(t99)
-  if(any(dNeq(math_3333to99(math_99to3333(t99)),t99))) &
+  if (any(dNeq(math_3333to99(math_99to3333(t99)),t99))) &
     error stop 'math_3333to99/math_99to3333'
 
   call random_number(v6)
-  if(any(dNeq(math_sym33to6(math_6toSym33(v6)),v6))) &
+  if (any(dNeq(math_sym33to6(math_6toSym33(v6)),v6))) &
     error stop 'math_sym33to6/math_6toSym33'
 
   call random_number(t66)
-  if(any(dNeq(math_sym3333to66(math_66toSym3333(t66)),t66,1.0e-15_pReal))) &
+  if (any(dNeq(math_sym3333to66(math_66toSym3333(t66)),t66,1.0e-15_pReal))) &
     error stop 'math_sym3333to66/math_66toSym3333'
 
+  if (any(dNeq(math_3333toVoigt66(math_Voigt66to3333(t66)),t66,1.0e-15_pReal))) &
+    error stop 'math_3333toVoigt66/math_Voigt66to3333'
+
   call random_number(v6)
-  if(any(dNeq0(math_6toSym33(v6) - math_symmetric33(math_6toSym33(v6))))) &
+  if (any(dNeq0(math_6toSym33(v6) - math_symmetric33(math_6toSym33(v6))))) &
     error stop 'math_symmetric33'
 
   call random_number(v3_1)
@@ -1270,34 +1299,34 @@ subroutine selfTest
   call random_number(v3_3)
   call random_number(v3_4)
 
-  if(dNeq(abs(dot_product(math_cross(v3_1-v3_4,v3_2-v3_4),v3_3-v3_4))/6.0, &
+  if (dNeq(abs(dot_product(math_cross(v3_1-v3_4,v3_2-v3_4),v3_3-v3_4))/6.0, &
           math_volTetrahedron(v3_1,v3_2,v3_3,v3_4),tol=1.0e-12_pReal)) &
     error stop 'math_volTetrahedron'
 
   call random_number(t33)
-  if(dNeq(math_det33(math_symmetric33(t33)),math_detSym33(math_symmetric33(t33)),tol=1.0e-12_pReal)) &
+  if (dNeq(math_det33(math_symmetric33(t33)),math_detSym33(math_symmetric33(t33)),tol=1.0e-12_pReal)) &
     error stop 'math_det33/math_detSym33'
 
-  if(any(dNeq(t33+transpose(t33),math_mul3333xx33(math_identity4th(),t33+transpose(t33))))) &
+  if (any(dNeq(t33+transpose(t33),math_mul3333xx33(math_identity4th(),t33+transpose(t33))))) &
     error stop 'math_mul3333xx33/math_identity4th'
 
-  if(any(dNeq0(math_eye(3),math_inv33(math_I3)))) &
+  if (any(dNeq0(math_eye(3),math_inv33(math_I3)))) &
     error stop 'math_inv33(math_I3)'
 
   do while(abs(math_det33(t33))<1.0e-9_pReal)
     call random_number(t33)
   enddo
-  if(any(dNeq0(matmul(t33,math_inv33(t33)) - math_eye(3),tol=1.0e-9_pReal))) &
+  if (any(dNeq0(matmul(t33,math_inv33(t33)) - math_eye(3),tol=1.0e-9_pReal))) &
     error stop 'math_inv33'
 
   call math_invert33(t33_2,det,e,t33)
-  if(any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pReal)) .or. e) &
+  if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pReal)) .or. e) &
     error stop 'math_invert33: T:T^-1 != I'
-  if(dNeq(det,math_det33(t33),tol=1.0e-12_pReal)) &
+  if (dNeq(det,math_det33(t33),tol=1.0e-12_pReal)) &
     error stop 'math_invert33 (determinant)'
 
   call math_invert(t33_2,e,t33)
-  if(any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pReal)) .or. e) &
+  if (any(dNeq0(matmul(t33,t33_2) - math_eye(3),tol=1.0e-9_pReal)) .or. e) &
     error stop 'math_invert t33'
 
   do while(math_det33(t33)<1.0e-2_pReal)                                                            ! O(det(F)) = 1
@@ -1305,7 +1334,7 @@ subroutine selfTest
   enddo
   t33_2 = math_rotationalPart(transpose(t33))
   t33   = math_rotationalPart(t33)
-  if(any(dNeq0(matmul(t33_2,t33) - math_I3,tol=1.0e-10_pReal))) &
+  if (any(dNeq0(matmul(t33_2,t33) - math_I3,tol=1.0e-10_pReal))) &
     error stop 'math_rotationalPart'
 
   call random_number(r)
@@ -1313,33 +1342,33 @@ subroutine selfTest
   txx = math_eye(d)
   allocate(txx_2(d,d))
   call math_invert(txx_2,e,txx)
-  if(any(dNeq0(txx_2,txx) .or. e)) &
+  if (any(dNeq0(txx_2,txx) .or. e)) &
     error stop 'math_invert(txx)/math_eye'
 
   call math_invert(t99_2,e,t99) ! not sure how likely it is that we get a singular matrix
-  if(any(dNeq0(matmul(t99_2,t99)-math_eye(9),tol=1.0e-9_pReal)) .or. e) &
+  if (any(dNeq0(matmul(t99_2,t99)-math_eye(9),tol=1.0e-9_pReal)) .or. e) &
     error stop 'math_invert(t99)'
 
-  if(any(dNeq(math_clip([4.0_pReal,9.0_pReal],5.0_pReal,6.5_pReal),[5.0_pReal,6.5_pReal]))) &
+  if (any(dNeq(math_clip([4.0_pReal,9.0_pReal],5.0_pReal,6.5_pReal),[5.0_pReal,6.5_pReal]))) &
     error stop 'math_clip'
 
-  if(math_factorial(10) /= 3628800) &
+  if (math_factorial(10) /= 3628800) &
     error stop 'math_factorial'
 
-  if(math_binomial(49,6) /= 13983816) &
+  if (math_binomial(49,6) /= 13983816) &
     error stop 'math_binomial'
 
-  if(math_multinomial([1,2,3,4]) /= 12600) &
+  if (math_multinomial([1,2,3,4]) /= 12600) &
     error stop 'math_multinomial'
 
   ijk = cshift([1,2,3],int(r*1.0e2_pReal))
-  if(dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),+1.0_pReal)) &
+  if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),+1.0_pReal)) &
     error stop 'math_LeviCivita(even)'
   ijk = cshift([3,2,1],int(r*2.0e2_pReal))
-  if(dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),-1.0_pReal)) &
+  if (dNeq(math_LeviCivita(ijk(1),ijk(2),ijk(3)),-1.0_pReal)) &
     error stop 'math_LeviCivita(odd)'
   ijk = cshift([2,2,1],int(r*2.0e2_pReal))
-  if(dNeq0(math_LeviCivita(ijk(1),ijk(2),ijk(3)))) &
+  if (dNeq0(math_LeviCivita(ijk(1),ijk(2),ijk(3)))) &
     error stop 'math_LeviCivita'
 
 end subroutine selfTest

src/mesh/DAMASK_mesh.f90

@@ -86,7 +86,7 @@ program DAMASK_mesh
 !--------------------------------------------------------------------------------------------------
 ! init DAMASK (all modules)
   call CPFEM_initAll
-  print'(/,a)', ' <<<+-  DAMASK_mesh init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  DAMASK_mesh init  -+>>>'; flush(IO_STDOUT)
 
 !---------------------------------------------------------------------
 ! reading field information from numerics file and do sanity checks
@@ -115,16 +115,16 @@ program DAMASK_mesh
         case('$Loadcase')
           N_def = N_def + 1
       end select
-    enddo                                                                                           ! count all identifiers to allocate memory and do sanity check
+    end do                                                                                           ! count all identifiers to allocate memory and do sanity check
-  enddo
+  end do
 
-  if(N_def < 1) call IO_error(error_ID = 837)
+  if (N_def < 1) call IO_error(error_ID = 837)
   allocate(loadCases(N_def))
 
   do i = 1, size(loadCases)
     allocate(loadCases(i)%fieldBC(1))
     loadCases(i)%fieldBC(1)%ID = FIELD_MECH_ID
-  enddo
+  end do
 
   do i = 1, size(loadCases)
     loadCases(i)%fieldBC(1)%nComponents = dimPlex                                                   !< X, Y (, Z) displacements
@@ -138,12 +138,12 @@ program DAMASK_mesh
         case (3)
           loadCases(i)%fieldBC(1)%componentBC(component)%ID = COMPONENT_MECH_Z_ID
       end select
-    enddo
+    end do
     do component = 1, loadCases(i)%fieldBC(1)%nComponents
       allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal)
       allocate(loadCases(i)%fieldBC(1)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
-    enddo
+    end do
-  enddo
+  end do
 
 !--------------------------------------------------------------------------------------------------
 ! reading the load case and assign values to the allocated data structure
@@ -163,7 +163,7 @@ program DAMASK_mesh
           currentFaceSet = -1
           do faceSet = 1, mesh_Nboundaries
             if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet
-          enddo
+          end do
           if (currentFaceSet < 0) call IO_error(error_ID = 837, ext_msg = 'invalid BC')
         case('t')
           loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1)
@@ -192,11 +192,11 @@ program DAMASK_mesh
                    .true.
                loadCases(currentLoadCase)%fieldBC(1)%componentBC(component)%Value(currentFaceSet) = &
                    IO_floatValue(line,chunkPos,i+1)
-             endif
+             end if
-           enddo
+           end do
       end select
-    enddo
+    end do
-  enddo
+  end do
 
 !--------------------------------------------------------------------------------------------------
 ! consistency checks and output of load case
@@ -204,28 +204,28 @@ program DAMASK_mesh
   errorID = 0
   checkLoadcases: do currentLoadCase = 1, size(loadCases)
     write (loadcase_string, '(i0)' ) currentLoadCase
-    print'(a,i0)', ' load case: ', currentLoadCase
+    print'(/,1x,a,i0)', 'load case: ', currentLoadCase
     if (.not. loadCases(currentLoadCase)%followFormerTrajectory) &
-      print'(a)', '  drop guessing along trajectory'
+      print'(2x,a)', 'drop guessing along trajectory'
-    print'(a)', '  Field '//trim(FIELD_MECH_label)
+    print'(2x,a)', 'Field '//trim(FIELD_MECH_label)
 
     do faceSet = 1, mesh_Nboundaries
        do component = 1, loadCases(currentLoadCase)%fieldBC(1)%nComponents
          if (loadCases(currentLoadCase)%fieldBC(1)%componentBC(component)%Mask(faceSet)) &
-           print'(a,i2,a,i2,a,f12.7)', '    Face  ', mesh_boundaries(faceSet), &
+           print'(a,i2,a,i2,a,f12.7)', &
-                                       ' Component ', component, &
+           '    Face ', mesh_boundaries(faceSet), &
-                                       ' Value ', loadCases(currentLoadCase)%fieldBC(1)% &
+           ' Component ', component, &
-                                                          componentBC(component)%Value(faceSet)
+           ' Value ', loadCases(currentLoadCase)%fieldBC(1)%componentBC(component)%Value(faceSet)
-      enddo
+      end do
-    enddo
+    end do
-    print'(a,f12.6)', '  time:       ', loadCases(currentLoadCase)%time
+    print'(2x,a,f12.6)', 'time:       ', loadCases(currentLoadCase)%time
     if (loadCases(currentLoadCase)%incs < 1)             errorID = 835                            ! non-positive incs count
-    print'(a,i5)',    '  increments: ', loadCases(currentLoadCase)%incs
+    print'(2x,a,i5)',    'increments: ', loadCases(currentLoadCase)%incs
     if (loadCases(currentLoadCase)%outputfrequency < 1)  errorID = 836                            ! non-positive result frequency
-    print'(a,i5)',    '  output  frequency:  ', &
+    print'(2x,a,i5)',    'output frequency: ', &
                loadCases(currentLoadCase)%outputfrequency
     if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string)                 ! exit with error message
-  enddo checkLoadcases
+  end do checkLoadcases
 
 !--------------------------------------------------------------------------------------------------
 ! doing initialization depending on active solvers
@@ -235,9 +235,9 @@ program DAMASK_mesh
   if (worldrank == 0) then
     open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
     write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded'                  ! statistics file
-  endif
+  end if
 
-  print'(/,a)', ' ... writing initial configuration to file ........................'
+  print'(/,1x,a)', '... writing initial configuration to file .................................'
   flush(IO_STDOUT)
   call CPFEM_results(0,0.0_pReal)
 
@@ -262,7 +262,7 @@ program DAMASK_mesh
 
 !--------------------------------------------------------------------------------------------------
 ! report begin of new step
-        print'(/,a)', ' ###########################################################################'
+        print'(/,1x,a)', '###########################################################################'
         print'(1x,a,es12.5,6(a,i0))',&
                 'Time', time, &
                 's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,&
@@ -281,60 +281,60 @@ program DAMASK_mesh
         stagIterate = .true.
         do while (stagIterate)
           solres(1) = FEM_mechanical_solution(incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(1))
-          if(.not. solres(1)%converged) exit
+          if (.not. solres(1)%converged) exit
 
           stagIter = stagIter + 1
           stagIterate =            stagIter < stagItMax &
                        .and.       all(solres(:)%converged) &
                        .and. .not. all(solres(:)%stagConverged)                                     ! stationary with respect to staggered iteration
-        enddo
+        end do
 
 ! check solution
         cutBack = .False.
-        if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then                       ! no solution found
+        if (.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then                       ! no solution found
           if (cutBackLevel < maxCutBack) then                                                       ! do cut back
             cutBack = .True.
             stepFraction = (stepFraction - 1) * subStepFactor                                       ! adjust to new denominator
             cutBackLevel = cutBackLevel + 1
             time    = time - timeinc                                                                ! rewind time
             timeinc = timeinc/2.0_pReal
-            print'(/,a)', ' cutting back'
+            print'(/,1x,a)', 'cutting back'
           else                                                                                      ! default behavior, exit if spectral solver does not converge
             if (worldrank == 0) close(statUnit)
             call IO_error(950)
-          endif
+          end if
         else
           guess = .true.                                                                            ! start guessing after first converged (sub)inc
           timeIncOld = timeinc
-        endif
+        end if
         if (.not. cutBack .and. worldrank == 0) &
           write(statUnit,*) totalIncsCounter, time, cutBackLevel, &
                             solres%converged, solres%iterationsNeeded                               ! write statistics about accepted solution
-      enddo subStepLooping
+      end do subStepLooping
 
       cutBackLevel = max(0, cutBackLevel - 1)                                                       ! try half number of subincs next inc
 
       if (all(solres(:)%converged)) then
-        print'(/,a,i0,a)', ' increment ', totalIncsCounter, ' converged'
+        print'(/,1x,a,i0,a)', 'increment ', totalIncsCounter, ' converged'
       else
-        print'(/,a,i0,a)', ' increment ', totalIncsCounter, ' NOT converged'
+        print'(/,1x,a,i0,a)', 'increment ', totalIncsCounter, ' NOT converged'
-      endif; flush(IO_STDOUT)
+      end if; flush(IO_STDOUT)
 
       if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then                            ! at output frequency
-        print'(/,a)', ' ... writing results to file ......................................'
+        print'(/,1x,a)', '... writing results to file ...............................................'
         call FEM_mechanical_updateCoords
         call CPFEM_results(totalIncsCounter,time)
-      endif
+      end if
 
 
-    enddo incLooping
+    end do incLooping
 
-  enddo loadCaseLooping
+  end do loadCaseLooping
 
 
 !--------------------------------------------------------------------------------------------------
 ! report summary of whole calculation
-  print'(/,a)', ' ###########################################################################'
+  print'(/,1x,a)', '###########################################################################'
   if (worldrank == 0) close(statUnit)
 
   call quit(0)                                                                                      ! no complains ;)

src/mesh/FEM_quadrature.f90

@@ -41,10 +41,10 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine FEM_quadrature_init()
 
-  print'(/,a)', ' <<<+-  FEM_quadrature init  -+>>>'; flush(6)
+  print'(/,1x,a)', '<<<+-  FEM_quadrature init  -+>>>'; flush(6)
 
-  print*, 'L. Zhang et al., Journal of Computational Mathematics 27(1):89-96, 2009'
+  print'(/,1x,a)', 'L. Zhang et al., Journal of Computational Mathematics 27(1):89-96, 2009'
-  print*, 'https://www.jstor.org/stable/43693493'
+  print'(  1x,a)', 'https://www.jstor.org/stable/43693493'
 
 !--------------------------------------------------------------------------------------------------
 ! 2D linear

src/mesh/FEM_utilities.f90

@@ -96,7 +96,7 @@ subroutine FEM_utilities_init
   logical :: debugPETSc                                                                             !< use some in debug defined options for more verbose PETSc solution
 
 
-  print'(/,a)',   ' <<<+-  FEM_utilities init  -+>>>'
+  print'(/,1x,a)',   '<<<+-  FEM_utilities init  -+>>>'
 
   num_mesh    => config_numerics%get('mesh',defaultVal=emptyDict)
 
@@ -111,10 +111,10 @@ subroutine FEM_utilities_init
   debug_mesh  => config_debug%get('mesh',defaultVal=emptyList)
   debugPETSc  =  debug_mesh%contains('PETSc')
 
-  if(debugPETSc) print'(3(/,a),/)', &
+  if(debugPETSc) print'(3(/,1x,a),/)', &
-                 ' Initializing PETSc with debug options: ', &
+                 'Initializing PETSc with debug options: ', &
                  trim(PETScDebug), &
-                 ' add more using the "PETSc_options" keyword in numerics.yaml'
+                 'add more using the "PETSc_options" keyword in numerics.yaml'
   flush(IO_STDOUT)
   call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr)
   CHKERRQ(ierr)
@@ -149,8 +149,7 @@ subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData)
 
   PetscErrorCode :: ierr
 
-
+  print'(/,1x,a)', '... evaluating constitutive response ......................................'
-  print'(/,a)', ' ... evaluating constitutive response ......................................'
 
   call homogenization_mechanical_response(timeinc,[1,mesh_maxNips],[1,mesh_NcpElems])                ! calculate P field
   if (.not. terminallyIll) &

src/mesh/discretization_mesh.f90

@@ -51,7 +51,7 @@ module discretization_mesh
 
   real(pReal), pointer, dimension(:) :: &
     mesh_node0_temp
-  
+
   real(pReal), dimension(:,:,:), allocatable :: &
     mesh_ipCoordinates                                                                              !< IP x,y,z coordinates (after deformation!)
 
@@ -88,7 +88,7 @@ subroutine discretization_mesh_init(restart)
   integer :: p_i                                                                                    !< integration order (quadrature rule)
   type(tvec) :: coords_node0
 
-  print'(/,a)',   ' <<<+-  discretization_mesh init  -+>>>'
+  print'(/,1x,a)',   '<<<+-  discretization_mesh init  -+>>>'
 
 !--------------------------------------------------------------------------------
 ! read numerics parameter
@@ -106,6 +106,7 @@ subroutine discretization_mesh_init(restart)
   CHKERRQ(ierr)
   call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr)
   CHKERRQ(ierr)
+  print'()'
   call DMView(globalMesh, PETSC_VIEWER_STDOUT_WORLD,ierr)
   CHKERRQ(ierr)
 
@@ -173,7 +174,7 @@ subroutine discretization_mesh_init(restart)
                            reshape(mesh_ipCoordinates,[3,mesh_maxNips*mesh_NcpElems]), &
                            mesh_node0)
 
-  call writeGeometry(reshape(mesh_ipCoordinates,[3,mesh_maxNips*mesh_NcpElems]),mesh_node0)  
+  call writeGeometry(reshape(mesh_ipCoordinates,[3,mesh_maxNips*mesh_NcpElems]),mesh_node0)
 
 end subroutine discretization_mesh_init
 
@@ -249,18 +250,18 @@ subroutine writeGeometry(coordinates_points,coordinates_nodes)
   real(pReal), dimension(:,:), intent(in) :: &
   coordinates_nodes, &
   coordinates_points
-  
+
   call results_openJobFile
   call results_closeGroup(results_addGroup('geometry'))
-  
+
   call results_writeDataset(coordinates_nodes,'geometry','x_n', &
         'initial coordinates of the nodes','m')
-  
+
   call results_writeDataset(coordinates_points,'geometry','x_p', &
         'initial coordinates of the materialpoints (cell centers)','m')
-  
+
   call results_closeJobFile
-  
+
   end subroutine writeGeometry
 
 end module discretization_mesh

src/mesh/mesh_mech_FEM.f90

@@ -48,9 +48,9 @@ module mesh_mechanical_FEM
     real(pReal) :: &
       eps_struct_atol, &                                                                            !< absolute tolerance for mechanical equilibrium
       eps_struct_rtol                                                                               !< relative tolerance for mechanical equilibrium
-  end type tNumerics   
+  end type tNumerics
 
-  type(tNumerics), private :: num 
+  type(tNumerics), private :: num
 !--------------------------------------------------------------------------------------------------
 ! PETSc data
   SNES                           :: mechanical_snes
@@ -112,8 +112,8 @@ subroutine FEM_mechanical_init(fieldBC)
   real(pReal), dimension(3,3) :: devNull
   class(tNode), pointer :: &
     num_mesh
-   
+
-  print'(/,a)', ' <<<+-  FEM_mech init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  FEM_mech init  -+>>>'; flush(IO_STDOUT)
 
 !-----------------------------------------------------------------------------
 ! read numerical parametes and do sanity checks
@@ -123,7 +123,7 @@ subroutine FEM_mechanical_init(fieldBC)
   num%BBarStabilisation = num_mesh%get_asBool('bbarstabilisation',defaultVal = .false.)
   num%eps_struct_atol   = num_mesh%get_asFloat('eps_struct_atol', defaultVal = 1.0e-10_pReal)
   num%eps_struct_rtol   = num_mesh%get_asFloat('eps_struct_rtol', defaultVal = 1.0e-4_pReal)
-  
+
   if (num%itmax <= 1)                       call IO_error(301,ext_msg='itmax')
   if (num%eps_struct_rtol <= 0.0_pReal)     call IO_error(301,ext_msg='eps_struct_rtol')
   if (num%eps_struct_atol <= 0.0_pReal)     call IO_error(301,ext_msg='eps_struct_atol')
@@ -302,7 +302,7 @@ type(tSolutionState) function FEM_mechanical_solution( &
     CHKERRQ(ierr)
   endif
 
-  print'(/,a)', ' ==========================================================================='
+  print'(/,1x,a)', '==========================================================================='
   flush(IO_STDOUT)
 
 end function FEM_mechanical_solution
@@ -362,7 +362,7 @@ subroutine FEM_mechanical_formResidual(dm_local,xx_local,f_local,dummy,ierr)
 !--------------------------------------------------------------------------------------------------
 ! evaluate field derivatives
   do cell = cellStart, cellEnd-1                                                                    !< loop over all elements
-    
+
     call PetscSectionGetNumFields(section,numFields,ierr)
     CHKERRQ(ierr)
     call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr)                             !< get Dofs belonging to element
@@ -663,8 +663,8 @@ subroutine FEM_mechanical_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reaso
   print'(/,1x,a,a,i0,a,i0,f0.3)', trim(incInfo), &
                   ' @ Iteration ',PETScIter,' mechanical residual norm = ', &
                                                   int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol)
-  print'(/,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
+  print'(/,1x,a,/,2(3(2x,f12.4,1x)/),3(2x,f12.4,1x))', &
-    ' Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal
+    'Piola--Kirchhoff stress / MPa =',transpose(P_av)*1.e-6_pReal
   flush(IO_STDOUT)
 
 end subroutine FEM_mechanical_converged
@@ -679,7 +679,7 @@ subroutine FEM_mechanical_updateCoords()
     nodeCoords_linear                                                                               !< nodal coordinates (dimPlex*Nnodes)
   real(pReal), pointer, dimension(:,:) :: &
     nodeCoords                                                                                      !< nodal coordinates (3,Nnodes)
-  real(pReal), pointer, dimension(:,:,:) :: &                                                       
+  real(pReal), pointer, dimension(:,:,:) :: &
     ipCoords                                                                                        !< ip coordinates (3,nQuadrature,mesh_NcpElems)
 
   integer :: &
@@ -720,7 +720,7 @@ subroutine FEM_mechanical_updateCoords()
   call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr); CHKERRQ(ierr)
   call PetscDSGetTabulation(mechQuad,0,basisField,basisFieldDer,ierr); CHKERRQ(ierr)
   allocate(ipCoords(3,nQuadrature,mesh_NcpElems),source=0.0_pReal)
-  do c=cellStart,cellEnd-1                                                                                      
+  do c=cellStart,cellEnd-1
     qOffset=0
     call DMPlexVecGetClosure(dm_local,section,x_local,c,x_scal,ierr); CHKERRQ(ierr)                             !< get nodal coordinates of each element
     do qPt=0,nQuadrature-1
@@ -737,8 +737,8 @@ subroutine FEM_mechanical_updateCoords()
         enddo
       enddo
     enddo
-    call DMPlexVecRestoreClosure(dm_local,section,x_local,c,x_scal,ierr); CHKERRQ(ierr)     
+    call DMPlexVecRestoreClosure(dm_local,section,x_local,c,x_scal,ierr); CHKERRQ(ierr)
-  end do    
+  end do
   call discretization_setIPcoords(reshape(ipCoords,[3,mesh_NcpElems*nQuadrature]))
   call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr)
 

src/parallelization.f90

@@ -76,11 +76,11 @@ subroutine parallelization_init
   call MPI_Comm_rank(MPI_COMM_WORLD,worldrank,err)
   if (err /= 0)                              error stop 'Could not determine worldrank'
 
-  if (worldrank == 0) print'(/,a)',  ' <<<+-  parallelization init  -+>>>'
+  if (worldrank == 0) print'(/,1x,a)', '<<<+-  parallelization init  -+>>>'
 
   call MPI_Comm_size(MPI_COMM_WORLD,worldsize,err)
   if (err /= 0)                              error stop 'Could not determine worldsize'
-  if (worldrank == 0) print'(a,i3)', ' MPI processes: ',worldsize
+  if (worldrank == 0) print'(/,1x,a,i3)', 'MPI processes: ',worldsize
 
   call MPI_Type_size(MPI_INTEGER,typeSize,err)
   if (err /= 0)                              error stop 'Could not determine MPI integer size'
@@ -97,16 +97,16 @@ subroutine parallelization_init
 
 !$ call get_environment_variable(name='OMP_NUM_THREADS',value=NumThreadsString,STATUS=got_env)
 !$ if(got_env /= 0) then
-!$   print*, 'Could not get $OMP_NUM_THREADS, using default'
+!$   print'(1x,a)', 'Could not get $OMP_NUM_THREADS, using default'
 !$   OMP_NUM_THREADS = 4_pI32
 !$ else
 !$   read(NumThreadsString,'(i6)') OMP_NUM_THREADS
 !$   if (OMP_NUM_THREADS < 1_pI32) then
-!$     print*, 'Invalid OMP_NUM_THREADS: "'//trim(NumThreadsString)//'", using default'
+!$     print'(1x,a)', 'Invalid OMP_NUM_THREADS: "'//trim(NumThreadsString)//'", using default'
 !$     OMP_NUM_THREADS = 4_pI32
 !$   endif
 !$ endif
-!$ print'(a,i2)',   ' OMP_NUM_THREADS: ',OMP_NUM_THREADS
+!$ print'(1x,a,1x,i2)',   'OMP_NUM_THREADS:',OMP_NUM_THREADS
 !$ call omp_set_num_threads(OMP_NUM_THREADS)
 
 end subroutine parallelization_init

src/phase.f90

@@ -5,6 +5,7 @@
 !--------------------------------------------------------------------------------------------------
 module phase
   use prec
+  use constants
   use math
   use rotations
   use IO
@@ -230,15 +231,15 @@ module phase
     end function phase_mechanical_constitutive
 
     !ToDo: Merge all the stiffness functions
-    module function phase_homogenizedC(ph,en) result(C)
+    module function phase_homogenizedC66(ph,en) result(C)
       integer, intent(in) :: ph, en
       real(pReal), dimension(6,6) :: C
-    end function phase_homogenizedC
+    end function phase_homogenizedC66
-    module function phase_damage_C(C_homogenized,ph,en) result(C)
+    module function phase_damage_C66(C66,ph,en) result(C66_degraded)
-      real(pReal), dimension(3,3,3,3), intent(in)  :: C_homogenized
+      real(pReal), dimension(6,6), intent(in)  :: C66
-      integer,                         intent(in)  :: ph,en
+      integer,                     intent(in)  :: ph,en
-      real(pReal), dimension(3,3,3,3) :: C
+      real(pReal), dimension(6,6) :: C66_degraded
-    end function phase_damage_C
+    end function phase_damage_C66
 
     module function phase_f_phi(phi,co,ce) result(f)
       integer, intent(in) :: ce,co
@@ -299,7 +300,7 @@ module phase
 
   public :: &
     phase_init, &
-    phase_homogenizedC, &
+    phase_homogenizedC66, &
     phase_f_phi, &
     phase_f_T, &
     phase_K_phi, &
@@ -343,7 +344,7 @@ subroutine phase_init
     phase
 
 
-  print'(/,a)', ' <<<+-  phase init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  phase init  -+>>>'; flush(IO_STDOUT)
 
   debug_constitutive => config_debug%get('phase', defaultVal=emptyList)
   debugConstitutive%basic     = debug_constitutive%contains('basic')
@@ -371,20 +372,20 @@ subroutine phase_init
       phase_cOverA(ph) = phase%get_asFloat('c/a')
     phase_rho(ph) = phase%get_asFloat('rho',defaultVal=0.0_pReal)
     allocate(phase_O_0(ph)%data(count(material_phaseID==ph)))
-  enddo
+  end do
 
   do ce = 1, size(material_phaseID,2)
     ma = discretization_materialAt((ce-1)/discretization_nIPs+1)
     do co = 1,homogenization_Nconstituents(material_homogenizationID(ce))
       ph = material_phaseID(co,ce)
       phase_O_0(ph)%data(material_phaseEntry(co,ce)) = material_O_0(ma)%data(co)
-    enddo
+    end do
-  enddo
+  end do
 
   allocate(phase_O(phases%length))
   do ph = 1,phases%length
     phase_O(ph)%data = phase_O_0(ph)%data
-  enddo
+  end do
 
   call mechanical_init(phases)
   call damage_init
@@ -471,7 +472,7 @@ subroutine phase_results()
     call mechanical_results(group,ph)
     call damage_results(group,ph)
 
-  enddo
+  end do
 
 end subroutine phase_results
 
@@ -495,7 +496,7 @@ subroutine crystallite_init()
     phases
 
 
-  print'(/,a)', ' <<<+-  crystallite init  -+>>>'
+  print'(/,1x,a)', '<<<+-  crystallite init  -+>>>'
 
   cMax = homogenization_maxNconstituents
   iMax = discretization_nIPs
@@ -515,28 +516,28 @@ subroutine crystallite_init()
   num%nState                 = num_crystallite%get_asInt   ('nState',           defaultVal=20)
   num%nStress                = num_crystallite%get_asInt   ('nStress',          defaultVal=40)
 
-  if(num%subStepMinCryst   <= 0.0_pReal)      call IO_error(301,ext_msg='subStepMinCryst')
+  if (num%subStepMinCryst   <= 0.0_pReal)      call IO_error(301,ext_msg='subStepMinCryst')
-  if(num%subStepSizeCryst  <= 0.0_pReal)      call IO_error(301,ext_msg='subStepSizeCryst')
+  if (num%subStepSizeCryst  <= 0.0_pReal)      call IO_error(301,ext_msg='subStepSizeCryst')
-  if(num%stepIncreaseCryst <= 0.0_pReal)      call IO_error(301,ext_msg='stepIncreaseCryst')
+  if (num%stepIncreaseCryst <= 0.0_pReal)      call IO_error(301,ext_msg='stepIncreaseCryst')
 
-  if(num%subStepSizeLp <= 0.0_pReal)          call IO_error(301,ext_msg='subStepSizeLp')
+  if (num%subStepSizeLp <= 0.0_pReal)          call IO_error(301,ext_msg='subStepSizeLp')
-  if(num%subStepSizeLi <= 0.0_pReal)          call IO_error(301,ext_msg='subStepSizeLi')
+  if (num%subStepSizeLi <= 0.0_pReal)          call IO_error(301,ext_msg='subStepSizeLi')
 
-  if(num%rtol_crystalliteState  <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteState')
+  if (num%rtol_crystalliteState  <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteState')
-  if(num%rtol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteStress')
+  if (num%rtol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='rtol_crystalliteStress')
-  if(num%atol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='atol_crystalliteStress')
+  if (num%atol_crystalliteStress <= 0.0_pReal) call IO_error(301,ext_msg='atol_crystalliteStress')
 
-  if(num%iJacoLpresiduum < 1)                 call IO_error(301,ext_msg='iJacoLpresiduum')
+  if (num%iJacoLpresiduum < 1)                 call IO_error(301,ext_msg='iJacoLpresiduum')
 
-  if(num%nState < 1)                          call IO_error(301,ext_msg='nState')
+  if (num%nState < 1)                          call IO_error(301,ext_msg='nState')
-  if(num%nStress< 1)                          call IO_error(301,ext_msg='nStress')
+  if (num%nStress< 1)                          call IO_error(301,ext_msg='nStress')
 
 
   phases => config_material%get('phase')
 
-  print'(a42,1x,i10)', '    # of elements:                       ', eMax
+  print'(/,a42,1x,i10)', '    # of elements:                       ', eMax
-  print'(a42,1x,i10)', '    # of integration points/element:     ', iMax
+  print'(  a42,1x,i10)', '    # of integration points/element:     ', iMax
-  print'(a42,1x,i10)', 'max # of constituents/integration point: ', cMax
+  print'(  a42,1x,i10)', 'max # of constituents/integration point: ', cMax
   flush(IO_STDOUT)
 
 
@@ -547,9 +548,9 @@ subroutine crystallite_init()
       do co = 1,homogenization_Nconstituents(material_homogenizationID(ce))
         call crystallite_orientations(co,ip,el)
         call plastic_dependentState(co,ip,el)                                                       ! update dependent state variables to be consistent with basic states
-     enddo
+     end do
-    enddo
+    end do
-  enddo
+  end do
   !$OMP END PARALLEL DO
 
 
@@ -642,7 +643,7 @@ subroutine phase_restartWrite(fileHandle)
 
     call HDF5_closeGroup(groupHandle(2))
 
-  enddo
+  end do
 
   call HDF5_closeGroup(groupHandle(1))
 
@@ -670,7 +671,7 @@ subroutine phase_restartRead(fileHandle)
 
     call HDF5_closeGroup(groupHandle(2))
 
-  enddo
+  end do
 
   call HDF5_closeGroup(groupHandle(1))
 

src/phase_damage.f90

@@ -83,7 +83,7 @@ module subroutine damage_init
    source
   logical:: damage_active
 
-  print'(/,a)', ' <<<+-  phase:damage init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:damage init  -+>>>'
 
   phases => config_material%get('phase')
 
@@ -108,16 +108,16 @@ module subroutine damage_init
       param(ph)%D(1,1) = source%get_asFloat('D_11')
       if (any(phase_lattice(ph) == ['hP','tI'])) param(ph)%D(3,3) = source%get_asFloat('D_33')
       param(ph)%D = lattice_symmetrize_33(param(ph)%D,phase_lattice(ph))
-    endif
+    end if
 
-  enddo
+  end do
 
   allocate(phase_damage(phases%length), source = DAMAGE_UNDEFINED_ID)
 
   if (damage_active) then
     where(isobrittle_init()  ) phase_damage = DAMAGE_ISOBRITTLE_ID
     where(anisobrittle_init()) phase_damage = DAMAGE_ANISOBRITTLE_ID
-  endif
+  end if
 
   phase_damage_maxSizeDotState     = maxval(damageState%sizeDotState)
 
@@ -139,6 +139,7 @@ module function phase_damage_constitutive(Delta_t,co,ip,el) result(converged_)
   integer :: &
     ph, en
 
+
   ph = material_phaseID(co,(el-1)*discretization_nIPs + ip)
   en = material_phaseEntry(co,(el-1)*discretization_nIPs + ip)
 
@@ -150,20 +151,21 @@ end function phase_damage_constitutive
 !--------------------------------------------------------------------------------------------------
 !> @brief returns the degraded/modified elasticity matrix
 !--------------------------------------------------------------------------------------------------
-module function phase_damage_C(C_homogenized,ph,en) result(C)
+module function phase_damage_C66(C66,ph,en) result(C66_degraded)
+
+  real(pReal), dimension(6,6), intent(in)  :: C66
+  integer,                     intent(in)  :: ph,en
+  real(pReal), dimension(6,6) :: C66_degraded
 
-  real(pReal), dimension(3,3,3,3), intent(in)  :: C_homogenized
-  integer,                         intent(in)  :: ph,en
-  real(pReal), dimension(3,3,3,3) :: C
 
   damageType: select case (phase_damage(ph))
     case (DAMAGE_ISOBRITTLE_ID) damageType
-     C = C_homogenized * damage_phi(ph,en)**2
+     C66_degraded = C66 * damage_phi(ph,en)**2
     case default damageType
-     C = C_homogenized
+     C66_degraded = C66
   end select damageType
 
-end function phase_damage_C
+end function phase_damage_C66
 
 
 !--------------------------------------------------------------------------------------------------
@@ -181,7 +183,7 @@ module subroutine damage_restore(ce)
     if (damageState(material_phaseID(co,ce))%sizeState > 0) &
     damageState(material_phaseID(co,ce))%state( :,material_phaseEntry(co,ce)) = &
       damageState(material_phaseID(co,ce))%state0(:,material_phaseEntry(co,ce))
-  enddo
+  end do
 
 end subroutine damage_restore
 
@@ -242,11 +244,11 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
   if (damageState(ph)%sizeState == 0) then
     broken = .false.
     return
-  endif
+  end if
 
   converged_ = .true.
   broken = phase_damage_collectDotState(ph,en)
-  if(broken) return
+  if (broken) return
 
   size_so = damageState(ph)%sizeDotState
   damageState(ph)%state(1:size_so,en) = damageState(ph)%state0  (1:size_so,en) &
@@ -255,11 +257,11 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
 
   iteration: do NiterationState = 1, num%nState
 
-    if(nIterationState > 1) source_dotState(1:size_so,2) = source_dotState(1:size_so,1)
+    if (nIterationState > 1) source_dotState(1:size_so,2) = source_dotState(1:size_so,1)
     source_dotState(1:size_so,1) = damageState(ph)%dotState(:,en)
 
     broken = phase_damage_collectDotState(ph,en)
-    if(broken) exit iteration
+    if (broken) exit iteration
 
 
       zeta = damper(damageState(ph)%dotState(:,en),source_dotState(1:size_so,1),source_dotState(1:size_so,2))
@@ -274,12 +276,12 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
                                                damageState(ph)%atol(1:size_so))
 
 
-    if(converged_) then
+    if (converged_) then
       broken = phase_damage_deltaState(mechanical_F_e(ph,en),ph,en)
       exit iteration
-    endif
+    end if
 
-  enddo iteration
+  end do iteration
 
   broken = broken .or. .not. converged_
 
@@ -302,7 +304,7 @@ function integrateDamageState(Delta_t,ph,en) result(broken)
     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 if
 
   end function damper
 
@@ -358,7 +360,7 @@ function phase_damage_collectDotState(ph,en) result(broken)
 
     broken = broken .or. any(IEEE_is_NaN(damageState(ph)%dotState(:,en)))
 
-  endif
+  end if
 
 end function phase_damage_collectDotState
 
@@ -385,7 +387,7 @@ module function phase_K_phi(co,ce) result(K)
   integer, intent(in) :: co, ce
   real(pReal), dimension(3,3) :: K
   real(pReal), parameter :: l = 1.0_pReal
-  
+
   K = crystallite_push33ToRef(co,ce,param(material_phaseID(co,ce))%D) &
     * l**2.0_pReal
 
@@ -417,14 +419,14 @@ function phase_damage_deltaState(Fe, ph, en) result(broken)
    sourceType: select case (phase_damage(ph))
 
     case (DAMAGE_ISOBRITTLE_ID) sourceType
-      call isobrittle_deltaState(phase_homogenizedC(ph,en), Fe, ph,en)
+      call isobrittle_deltaState(phase_homogenizedC66(ph,en), Fe, ph,en)
       broken = any(IEEE_is_NaN(damageState(ph)%deltaState(:,en)))
-      if(.not. broken) then
+      if (.not. broken) then
         myOffset = damageState(ph)%offsetDeltaState
         mySize   = damageState(ph)%sizeDeltaState
         damageState(ph)%state(myOffset + 1: myOffset + mySize,en) = &
         damageState(ph)%state(myOffset + 1: myOffset + mySize,en) + damageState(ph)%deltaState(1:mySize,en)
-      endif
+      end if
 
   end select sourceType
 
@@ -454,7 +456,7 @@ function source_active(source_label)  result(active_source)
     sources => phase%get('damage',defaultVal=emptyList)
     src => sources%get(1)
     active_source(ph) = src%get_asString('type',defaultVal = 'x') == source_label
-  enddo
+  end do
 
 
 end function source_active
@@ -497,7 +499,7 @@ module subroutine damage_forward()
   do ph = 1, size(damageState)
     if (damageState(ph)%sizeState > 0) &
       damageState(ph)%state0 = damageState(ph)%state
-  enddo
+  end do
 
 end subroutine damage_forward
 

src/phase_damage_anisobrittle.f90

@@ -46,10 +46,10 @@ module function anisobrittle_init() result(mySources)
 
 
   mySources = source_active('anisobrittle')
-  if(count(mySources) == 0) return
+  if (count(mySources) == 0) return
 
-  print'(/,a)', ' <<<+-  phase:damage:anisobrittle init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:damage:anisobrittle init  -+>>>'
-  print'(a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT)
+  print'(/,a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT)
 
 
   phases => config_material%get('phase')
@@ -57,7 +57,7 @@ module function anisobrittle_init() result(mySources)
 
 
   do ph = 1, phases%length
-    if(mySources(ph)) then
+    if (mySources(ph)) then
       phase => phases%get(ph)
       sources => phase%get('damage')
 
@@ -94,14 +94,14 @@ module function anisobrittle_init() result(mySources)
         Nmembers = count(material_phaseID==ph)
         call phase_allocateState(damageState(ph),Nmembers,1,1,0)
         damageState(ph)%atol = src%get_asFloat('atol_phi',defaultVal=1.0e-9_pReal)
-        if(any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi'
+        if (any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi'
 
       end associate
 
       if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_anisoBrittle)')
-    endif
+    end if
 
-  enddo
+  end do
 
 end function anisobrittle_init
 
@@ -136,7 +136,7 @@ module subroutine anisobrittle_dotState(S, ph,en)
             * ((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 + &
                (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**prm%q)
-    enddo
+    end do
   end associate
 
 end subroutine anisobrittle_dotState
@@ -159,7 +159,7 @@ module subroutine anisobrittle_results(phase,group)
         case ('f_phi')
           call results_writeDataset(stt,group,trim(prm%output(o)),'driving force','J/m³')
       end select
-    enddo outputsLoop
+    end do outputsLoop
   end associate
 
 end subroutine anisobrittle_results
@@ -200,7 +200,7 @@ module subroutine damage_anisobrittle_LiAndItsTangent(Ld, dLd_dTstar, S, ph,en)
       forall (k=1:3,l=1:3,m=1:3,n=1:3) &
         dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) &
                             + dudotd_dt*prm%cleavage_systems(k,l,1,i) * prm%cleavage_systems(m,n,1,i)
-    endif
+    end if
 
     traction_t = math_tensordot(S,prm%cleavage_systems(1:3,1:3,2,i))
     if (abs(traction_t) > traction_crit + tol_math_check) then
@@ -210,7 +210,7 @@ module subroutine damage_anisobrittle_LiAndItsTangent(Ld, dLd_dTstar, S, ph,en)
       forall (k=1:3,l=1:3,m=1:3,n=1:3) &
         dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) &
                             + dudott_dt*prm%cleavage_systems(k,l,2,i) * prm%cleavage_systems(m,n,2,i)
-    endif
+    end if
 
     traction_n = math_tensordot(S,prm%cleavage_systems(1:3,1:3,3,i))
     if (abs(traction_n) > traction_crit + tol_math_check) then
@@ -220,8 +220,8 @@ module subroutine damage_anisobrittle_LiAndItsTangent(Ld, dLd_dTstar, S, ph,en)
       forall (k=1:3,l=1:3,m=1:3,n=1:3) &
         dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) &
                             + dudotn_dt*prm%cleavage_systems(k,l,3,i) * prm%cleavage_systems(m,n,3,i)
-    endif
+    end if
-  enddo
+  end do
   end associate
 
 end subroutine damage_anisobrittle_LiAndItsTangent

src/phase_damage_isobrittle.f90

@@ -44,10 +44,10 @@ module function isobrittle_init() result(mySources)
 
 
   mySources = source_active('isobrittle')
-  if(count(mySources) == 0) return
+  if (count(mySources) == 0) return
 
-  print'(/,a)', ' <<<+-  phase:damage:isobrittle init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:damage:isobrittle init  -+>>>'
-  print'(a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT)
+  print'(/,a,i0)', ' # phases: ',count(mySources); flush(IO_STDOUT)
 
 
   phases => config_material%get('phase')
@@ -56,7 +56,7 @@ module function isobrittle_init() result(mySources)
   allocate(deltaState(phases%length))
 
   do ph = 1, phases%length
-    if(mySources(ph)) then
+    if (mySources(ph)) then
       phase => phases%get(ph)
       sources => phase%get('damage')
 
@@ -77,7 +77,7 @@ module function isobrittle_init() result(mySources)
         Nmembers = count(material_phaseID==ph)
         call phase_allocateState(damageState(ph),Nmembers,1,1,1)
         damageState(ph)%atol = src%get_asFloat('atol_phi',defaultVal=1.0e-9_pReal)
-        if(any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi'
+        if (any(damageState(ph)%atol < 0.0_pReal)) extmsg = trim(extmsg)//' atol_phi'
 
         stt%r_W => damageState(ph)%state(1,:)
         dlt%r_W => damageState(ph)%deltaState(1,:)
@@ -86,9 +86,9 @@ module function isobrittle_init() result(mySources)
 
 
       if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(damage_isobrittle)')
-    endif
+    end if
 
-  enddo
+  end do
 
 
 end function isobrittle_init
@@ -96,6 +96,7 @@ end function isobrittle_init
 
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates derived quantities from state
+! ToDo: Use Voigt directly
 !--------------------------------------------------------------------------------------------------
 module subroutine isobrittle_deltaState(C, Fe, ph,en)
 
@@ -109,13 +110,16 @@ module subroutine isobrittle_deltaState(C, Fe, ph,en)
     epsilon
   real(pReal) :: &
     r_W
+  real(pReal), dimension(6,6) :: &
+    C_sym
 
 
+  C_sym = math_sym3333to66(math_Voigt66to3333(C))
   epsilon = 0.5_pReal*math_sym33to6(matmul(transpose(Fe),Fe)-math_I3)
 
   associate(prm => param(ph), stt => state(ph), dlt => deltaState(ph))
 
-    r_W = 2.0_pReal*dot_product(epsilon,matmul(C,epsilon))/prm%W_crit
+    r_W = 2.0_pReal*dot_product(epsilon,matmul(C_sym,epsilon))/prm%W_crit
     dlt%r_W(en) = merge(r_W - stt%r_W(en), 0.0_pReal, r_W > stt%r_W(en))
 
   end associate
@@ -141,7 +145,7 @@ module subroutine isobrittle_results(phase,group)
         case ('f_phi')
           call results_writeDataset(stt,group,trim(prm%output(o)),'driving force','J/m³') ! Wrong, this is dimensionless
       end select
-    enddo outputsLoop
+    end do outputsLoop
 
   end associate
 

src/phase_mechanical.f90

@@ -168,19 +168,19 @@ submodule(phase) mechanical
       integer,     intent(in) :: ph,en
     end function plastic_dislotwin_homogenizedC
 
-    module function elastic_C66(ph) result(C66)
+    module function elastic_C66(ph,en) result(C66)
       real(pReal), dimension(6,6) :: C66
-      integer,     intent(in) :: ph
+      integer,     intent(in) :: ph, en
     end function elastic_C66
 
-    module function elastic_mu(ph) result(mu)
+    module function elastic_mu(ph,en) result(mu)
       real(pReal) :: mu
-      integer, intent(in) :: ph
+      integer, intent(in) :: ph, en
     end function elastic_mu
 
-    module function elastic_nu(ph) result(nu)
+    module function elastic_nu(ph,en) result(nu)
       real(pReal) :: nu
-      integer, intent(in) :: ph
+      integer, intent(in) :: ph, en
     end function elastic_nu
 
   end interface
@@ -205,6 +205,9 @@ module subroutine mechanical_init(phases)
     phases
 
   integer :: &
+    ce, &
+    co, &
+    ma, &
     ph, &
     en, &
     Nmembers
@@ -214,7 +217,7 @@ module subroutine mechanical_init(phases)
     phase, &
     mech
 
-  print'(/,a)', ' <<<+-  phase:mechanical init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical init  -+>>>'
 
 !-------------------------------------------------------------------------------------------------
   allocate(output_constituent(phases%length))
@@ -261,15 +264,21 @@ module subroutine mechanical_init(phases)
 #endif
   enddo
 
+  do ce = 1, size(material_phaseID,2)
+    ma = discretization_materialAt((ce-1)/discretization_nIPs+1)
+    do co = 1,homogenization_Nconstituents(material_homogenizationID(ce))
+      ph = material_phaseID(co,ce)
+      phase_mechanical_Fi0(ph)%data(1:3,1:3,material_phaseEntry(co,ce)) = material_F_i_0(ma)%data(1:3,1:3,co)
+    enddo
+  enddo
+
   do ph = 1, phases%length
     do en = 1, count(material_phaseID == ph)
 
       phase_mechanical_Fp0(ph)%data(1:3,1:3,en) = phase_O_0(ph)%data(en)%asMatrix()                 ! Fp reflects initial orientation (see 10.1016/j.actamat.2006.01.005)
       phase_mechanical_Fp0(ph)%data(1:3,1:3,en) = phase_mechanical_Fp0(ph)%data(1:3,1:3,en) &
                                                 / math_det33(phase_mechanical_Fp0(ph)%data(1:3,1:3,en))**(1.0_pReal/3.0_pReal)
-      phase_mechanical_Fi0(ph)%data(1:3,1:3,en) = math_I3
+      phase_mechanical_F0(ph)%data(1:3,1:3,en) = math_I3
-      phase_mechanical_F0(ph)%data(1:3,1:3,en)  = math_I3
-
       phase_mechanical_Fe(ph)%data(1:3,1:3,en) = math_inv33(matmul(phase_mechanical_Fi0(ph)%data(1:3,1:3,en), &
                                                                    phase_mechanical_Fp0(ph)%data(1:3,1:3,en)))  ! assuming that euler angles are given in internal strain free configuration
     enddo

src/phase_mechanical_eigen.f90

@@ -44,7 +44,7 @@ module subroutine eigen_init(phases)
     kinematics, &
     mechanics
 
-  print'(/,a)', ' <<<+-  phase:mechanical:eigen init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:eigen init  -+>>>'
 
 !--------------------------------------------------------------------------------------------------
 ! explicit eigen mechanisms
@@ -55,11 +55,11 @@ module subroutine eigen_init(phases)
     mechanics => phase%get('mechanical')
     kinematics => mechanics%get('eigen',defaultVal=emptyList)
     Nmodels(ph) = kinematics%length
-  enddo
+  end do
 
   allocate(model(maxval(Nmodels),phases%length), source = KINEMATICS_undefined_ID)
 
-  if(maxval(Nmodels) /= 0) then
+  if (maxval(Nmodels) /= 0) then
     where(thermalexpansion_init(maxval(Nmodels))) model = KINEMATICS_thermal_expansion_ID
   endif
 
@@ -97,8 +97,8 @@ function kinematics_active(kinematics_label,kinematics_length)  result(active_ki
     do k = 1, kinematics%length
       kinematics_type => kinematics%get(k)
       active_kinematics(k,ph) = kinematics_type%get_asString('type') == kinematics_label
-    enddo
+    end do
-  enddo
+  end do
 
 
 end function kinematics_active
@@ -125,11 +125,11 @@ function kinematics_active2(kinematics_label)  result(active_kinematics)
   do ph = 1, phases%length
     phase => phases%get(ph)
     kinematics => phase%get('damage',defaultVal=emptyList)
-    if(kinematics%length < 1) return
+    if (kinematics%length < 1) return
     kinematics_type => kinematics%get(1)
     if (.not. kinematics_type%contains('type')) continue
     active_kinematics(ph) = kinematics_type%get_asString('type',defaultVal='n/a') == kinematics_label
-  enddo
+  end do
 
 
 end function kinematics_active2
@@ -188,7 +188,7 @@ module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
         dLi_dS = dLi_dS + my_dLi_dS
         active = .true.
     end select kinematicsType
-  enddo KinematicsLoop
+  end do KinematicsLoop
 
   select case (model_damage(ph))
     case (KINEMATICS_cleavage_opening_ID)
@@ -198,7 +198,7 @@ module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
       active = .true.
   end select
 
-  if(.not. active) return
+  if (.not. active) return
 
   FiInv = math_inv33(Fi)
   detFi = math_det33(Fi)
@@ -209,7 +209,7 @@ module subroutine phase_LiAndItsTangents(Li, dLi_dS, dLi_dFi, &
     dLi_dS(1:3,1:3,i,j)  = matmul(matmul(Fi,dLi_dS(1:3,1:3,i,j)),FiInv)*detFi
     dLi_dFi(1:3,1:3,i,j) = dLi_dFi(1:3,1:3,i,j) + Li*FiInv(j,i)
     dLi_dFi(1:3,i,1:3,j) = dLi_dFi(1:3,i,1:3,j) + math_I3*temp_33(j,i) + Li*FiInv(j,i)
-  enddo; enddo
+  end do; end do
 
 end subroutine phase_LiAndItsTangents
 

src/phase_mechanical_eigen_cleavageopening.f90

@@ -21,8 +21,8 @@ module function damage_anisobrittle_init() result(myKinematics)
   myKinematics = kinematics_active2('anisobrittle')
   if(count(myKinematics) == 0) return
 
-  print'(/,a)', ' <<<+-  phase:mechanical:eigen:cleavageopening init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:eigen:cleavageopening init  -+>>>'
-  print'(a,i2)', ' # phases: ',count(myKinematics); flush(IO_STDOUT)
+  print'(/,a,i2)', ' # phases: ',count(myKinematics); flush(IO_STDOUT)
 
 end function damage_anisobrittle_init
 

src/phase_mechanical_eigen_thermalexpansion.f90

@@ -36,45 +36,45 @@ module function thermalexpansion_init(kinematics_length) result(myKinematics)
     kinematics, &
     kinematic_type
 
-  print'(/,a)', ' <<<+-  phase:mechanical:eigen:thermalexpansion init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:eigen:thermalexpansion init  -+>>>'
 
   myKinematics = kinematics_active('thermalexpansion',kinematics_length)
   Ninstances = count(myKinematics)
-  print'(a,i2)', ' # phases: ',Ninstances; flush(IO_STDOUT)
+  print'(/,a,i2)', ' # phases: ',Ninstances; flush(IO_STDOUT)
-  if(Ninstances == 0) return
+  if (Ninstances == 0) return
 
   phases => config_material%get('phase')
   allocate(param(Ninstances))
   allocate(kinematics_thermal_expansion_instance(phases%length), source=0)
 
   do p = 1, phases%length
-    if(any(myKinematics(:,p))) kinematics_thermal_expansion_instance(p) = count(myKinematics(:,1:p))
+    if (any(myKinematics(:,p))) kinematics_thermal_expansion_instance(p) = count(myKinematics(:,1:p))
     phase => phases%get(p)
-    if(count(myKinematics(:,p)) == 0) cycle
+    if (count(myKinematics(:,p)) == 0) cycle
     mech => phase%get('mechanical')
     kinematics => mech%get('eigen')
     do k = 1, kinematics%length
-      if(myKinematics(k,p)) then
+      if (myKinematics(k,p)) then
         associate(prm  => param(kinematics_thermal_expansion_instance(p)))
           kinematic_type => kinematics%get(k)
 
-          prm%T_ref = kinematic_type%get_asFloat('T_ref', defaultVal=0.0_pReal)
+          prm%T_ref = kinematic_type%get_asFloat('T_ref', defaultVal=T_ROOM)
 
           prm%A(1,1,1) = kinematic_type%get_asFloat('A_11')
-          prm%A(1,1,2) = kinematic_type%get_asFloat('A_11,T',defaultVal=0.0_pReal)
+          prm%A(1,1,2) = kinematic_type%get_asFloat('A_11,T',  defaultVal=0.0_pReal)
           prm%A(1,1,3) = kinematic_type%get_asFloat('A_11,T^2',defaultVal=0.0_pReal)
           if (any(phase_lattice(p) == ['hP','tI'])) then
             prm%A(3,3,1) = kinematic_type%get_asFloat('A_33')
-            prm%A(3,3,2) = kinematic_type%get_asFloat('A_33,T',defaultVal=0.0_pReal)
+            prm%A(3,3,2) = kinematic_type%get_asFloat('A_33,T',  defaultVal=0.0_pReal)
             prm%A(3,3,3) = kinematic_type%get_asFloat('A_33,T^2',defaultVal=0.0_pReal)
-          endif
+          end if
           do i=1, size(prm%A,3)
             prm%A(1:3,1:3,i) = lattice_symmetrize_33(prm%A(1:3,1:3,i),phase_lattice(p))
-          enddo
+          end do
         end associate
-      endif
+      end if
-    enddo
+    end do
-  enddo
+  end do
 
 end function thermalexpansion_init
 
@@ -92,20 +92,20 @@ module subroutine thermalexpansion_LiAndItsTangent(Li, dLi_dTstar, ph,me)
 
   real(pReal) :: T, dot_T
 
-  
+
   T     = thermal_T(ph,me)
   dot_T = thermal_dot_T(ph,me)
 
   associate(prm => param(kinematics_thermal_expansion_instance(ph)))
     Li = dot_T * ( &
-                  prm%A(1:3,1:3,1)*(T - prm%T_ref)**0 &                                             ! constant  coefficient
+                  prm%A(1:3,1:3,1) &                                                                ! constant  coefficient
-                + prm%A(1:3,1:3,2)*(T - prm%T_ref)**1 &                                             ! linear    coefficient
+                + prm%A(1:3,1:3,2)*(T - prm%T_ref)**1         &                                     ! linear    coefficient
-                + prm%A(1:3,1:3,3)*(T - prm%T_ref)**2 &                                             ! quadratic coefficient
+                + prm%A(1:3,1:3,3)*(T - prm%T_ref)**2         &                                     ! quadratic coefficient
                 ) / &
          (1.0_pReal &
-               + prm%A(1:3,1:3,1)*(T - prm%T_ref)**1 / 1. &
+               + prm%A(1:3,1:3,1)*(T - prm%T_ref)**1 / 1.0_pReal &
-               + prm%A(1:3,1:3,2)*(T - prm%T_ref)**2 / 2. &
+               + prm%A(1:3,1:3,2)*(T - prm%T_ref)**2 / 2.0_pReal &
-               + prm%A(1:3,1:3,3)*(T - prm%T_ref)**3 / 3. &
+               + prm%A(1:3,1:3,3)*(T - prm%T_ref)**3 / 3.0_pReal &
          )
   end associate
   dLi_dTstar = 0.0_pReal

src/phase_mechanical_elastic.f90

@@ -1,18 +1,24 @@
 submodule(phase:mechanical) elastic
 
   type :: tParameters
-    real(pReal), dimension(6,6) :: &
+    real(pReal),dimension(3) :: &
-      C66 = 0.0_pReal                                                                               !< Elastic constants in Voigt notation
+      C_11 = 0.0_pReal, &
+      C_12 = 0.0_pReal, &
+      C_13 = 0.0_pReal, &
+      C_33 = 0.0_pReal, &
+      C_44 = 0.0_pReal, &
+      C_66 = 0.0_pReal
     real(pReal) :: &
-      mu, &
+      T_ref
-      nu
   end type tParameters
 
   type(tParameters), allocatable, dimension(:) :: param
 
 contains
 
-
+!--------------------------------------------------------------------------------------------------
+!> @brief initialize elasticity
+!--------------------------------------------------------------------------------------------------
 module subroutine elastic_init(phases)
 
   class(tNode), pointer :: &
@@ -24,12 +30,12 @@ module subroutine elastic_init(phases)
     phase, &
     mech, &
     elastic
+  logical :: thermal_active
 
+  print'(/,1x,a)', '<<<+-  phase:mechanical:elastic init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:elastic:Hooke init  -+>>>'
 
-  print'(/,a)', ' <<<+-  phase:mechanical:elastic init  -+>>>'
+  print'(/,a,i0)', ' # phases: ',phases%length; flush(IO_STDOUT)
-  print'(/,a)', ' <<<+-  phase:mechanical:elastic:Hooke init  -+>>>'
-
-  print'(a,i0)', ' # phases: ',phases%length; flush(IO_STDOUT)
 
   allocate(param(phases%length))
 
@@ -41,32 +47,135 @@ module subroutine elastic_init(phases)
 
     associate(prm => param(ph))
 
-      prm%C66(1,1) = elastic%get_asFloat('C_11')
+      prm%T_ref = elastic%get_asFloat('T_ref', defaultVal=T_ROOM)
-      prm%C66(1,2) = elastic%get_asFloat('C_12')
-      prm%C66(4,4) = elastic%get_asFloat('C_44')
 
+      prm%C_11(1) = elastic%get_asFloat('C_11')
+      prm%C_11(2) = elastic%get_asFloat('C_11,T',  defaultVal=0.0_pReal)
+      prm%C_11(3) = elastic%get_asFloat('C_11,T^2',defaultVal=0.0_pReal)
+ 
+      prm%C_12(1) = elastic%get_asFloat('C_12')
+      prm%C_12(2) = elastic%get_asFloat('C_12,T',  defaultVal=0.0_pReal)
+      prm%C_12(3) = elastic%get_asFloat('C_12,T^2',defaultVal=0.0_pReal)
+ 
+      prm%C_44(1) = elastic%get_asFloat('C_44')
+      prm%C_44(2) = elastic%get_asFloat('C_44,T',  defaultVal=0.0_pReal)
+      prm%C_44(3) = elastic%get_asFloat('C_44,T^2',defaultVal=0.0_pReal)
+ 
       if (any(phase_lattice(ph) == ['hP','tI'])) then
-        prm%C66(1,3) = elastic%get_asFloat('C_13')
+        prm%C_13(1) = elastic%get_asFloat('C_13')
-        prm%C66(3,3) = elastic%get_asFloat('C_33')
+        prm%C_13(2) = elastic%get_asFloat('C_13,T',  defaultVal=0.0_pReal)
-      endif
+        prm%C_13(3) = elastic%get_asFloat('C_13,T^2',defaultVal=0.0_pReal)
-      if (phase_lattice(ph) == 'tI') prm%C66(6,6) = elastic%get_asFloat('C_66')
+ 
+        prm%C_33(1) = elastic%get_asFloat('C_33')
+        prm%C_33(2) = elastic%get_asFloat('C_33,T',  defaultVal=0.0_pReal)
+        prm%C_33(3) = elastic%get_asFloat('C_33,T^2',defaultVal=0.0_pReal)
+      end if
 
-      prm%C66 = lattice_symmetrize_C66(prm%C66,phase_lattice(ph))
+      if (phase_lattice(ph) == 'tI') then
-
+        prm%C_66(1) = elastic%get_asFloat('C_66')
-      prm%nu = lattice_equivalent_nu(prm%C66,'voigt')
+        prm%C_66(2) = elastic%get_asFloat('C_66,T',  defaultVal=0.0_pReal)
-      prm%mu = lattice_equivalent_mu(prm%C66,'voigt')
+        prm%C_66(3) = elastic%get_asFloat('C_66,T^2',defaultVal=0.0_pReal)
-      
+      end if
-      prm%C66 = math_sym3333to66(math_Voigt66to3333(prm%C66))                                       ! Literature data is in Voigt notation
 
     end associate
-  enddo
+  end do
 
 end subroutine elastic_init
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief returns the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to
+!> @brief return 6x6 elasticity tensor
+!--------------------------------------------------------------------------------------------------
+module function elastic_C66(ph,en) result(C66)
+
+  integer, intent(in) :: &
+    ph, &
+    en
+
+  real(pReal), dimension(6,6) :: C66
+  real(pReal) :: T
+
+
+  associate(prm => param(ph))
+    C66 = 0.0_pReal
+    T = thermal_T(ph,en)
+
+    C66(1,1) = prm%C_11(1) &
+             + prm%C_11(2)*(T - prm%T_ref)**1 &
+             + prm%C_11(3)*(T - prm%T_ref)**2
+
+    C66(1,2) = prm%C_12(1) &
+             + prm%C_12(2)*(T - prm%T_ref)**1 &
+             + prm%C_12(3)*(T - prm%T_ref)**2
+
+    C66(4,4) = prm%C_44(1) &
+             + prm%C_44(2)*(T - prm%T_ref)**1 &
+             + prm%C_44(3)*(T - prm%T_ref)**2
+
+
+    if (any(phase_lattice(ph) == ['hP','tI'])) then
+      C66(1,3) = prm%C_13(1) &
+               + prm%C_13(2)*(T - prm%T_ref)**1 &
+               + prm%C_13(3)*(T - prm%T_ref)**2
+
+      C66(3,3) = prm%C_33(1) &
+               + prm%C_33(2)*(T - prm%T_ref)**1 &
+               + prm%C_33(3)*(T - prm%T_ref)**2
+
+    end if
+
+    if (phase_lattice(ph) == 'tI') then
+      C66(6,6) = prm%C_66(1) &
+               + prm%C_66(2)*(T - prm%T_ref)**1 &
+               + prm%C_66(3)*(T - prm%T_ref)**2
+    end if
+
+    C66 = lattice_symmetrize_C66(C66,phase_lattice(ph))
+
+  end associate
+
+end function elastic_C66
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief return shear modulus
+!--------------------------------------------------------------------------------------------------
+module function elastic_mu(ph,en) result(mu)
+
+  integer, intent(in) :: &
+    ph, &
+    en
+  real(pReal) :: &
+    mu
+
+
+  mu = lattice_equivalent_mu(elastic_C66(ph,en),'voigt')
+
+end function elastic_mu
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief return Poisson ratio
+!--------------------------------------------------------------------------------------------------
+module function elastic_nu(ph,en) result(nu)
+
+  integer, intent(in) :: &
+    ph, &
+    en
+  real(pReal) :: &
+    nu
+
+
+  nu = lattice_equivalent_nu(elastic_C66(ph,en),'voigt')
+
+end function elastic_nu
+
+
+
+!--------------------------------------------------------------------------------------------------
+!> @brief return the 2nd Piola-Kirchhoff stress tensor and its tangent with respect to
 !> the elastic and intermediate deformation gradients using Hooke's law
+! ToDo: Use Voigt matrix directly
 !--------------------------------------------------------------------------------------------------
 module subroutine phase_hooke_SandItsTangents(S, dS_dFe, dS_dFi, &
                                               Fe, Fi, ph, en)
@@ -89,65 +198,36 @@ module subroutine phase_hooke_SandItsTangents(S, dS_dFe, dS_dFi, &
     i, j
 
 
-  C = math_66toSym3333(phase_homogenizedC(ph,en))
+  C = math_Voigt66to3333(phase_damage_C66(phase_homogenizedC66(ph,en),ph,en))
-  C = phase_damage_C(C,ph,en)
 
   E = 0.5_pReal*(matmul(transpose(Fe),Fe)-math_I3)                                                  !< Green-Lagrange strain in unloaded configuration
   S = math_mul3333xx33(C,matmul(matmul(transpose(Fi),E),Fi))                                        !< 2PK stress in lattice configuration in work conjugate with GL strain pulled back to lattice configuration
 
-  do i =1, 3;do j=1,3
+  do i =1,3; do j=1,3
     dS_dFe(i,j,1:3,1:3) = matmul(Fe,matmul(matmul(Fi,C(i,j,1:3,1:3)),transpose(Fi)))                !< dS_ij/dFe_kl = C_ijmn * Fi_lm * Fi_on * Fe_ko
     dS_dFi(i,j,1:3,1:3) = 2.0_pReal*matmul(matmul(E,Fi),C(i,j,1:3,1:3))                             !< dS_ij/dFi_kl = C_ijln * E_km * Fe_mn
-  enddo; enddo
+  end do; end do
 
 end subroutine phase_hooke_SandItsTangents
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief returns the homogenized elasticity matrix
+!> @brief Return the homogenized elasticity matrix.
-!> ToDo: homogenizedC66 would be more consistent
 !--------------------------------------------------------------------------------------------------
-module function phase_homogenizedC(ph,en) result(C)
+module function phase_homogenizedC66(ph,en) result(C)
 
   real(pReal), dimension(6,6) :: C
   integer,      intent(in)    :: ph, en
 
+
   plasticType: select case (phase_plasticity(ph))
     case (PLASTICITY_DISLOTWIN_ID) plasticType
      C = plastic_dislotwin_homogenizedC(ph,en)
     case default plasticType
-     C = param(ph)%C66
+     C = elastic_C66(ph,en)
   end select plasticType
 
-end function phase_homogenizedC
+end function phase_homogenizedC66
 
-module function elastic_C66(ph) result(C66)
-  real(pReal), dimension(6,6) :: C66
-  integer,     intent(in) :: ph
-
-
-  C66 = param(ph)%C66
-
-end function elastic_C66
-
-module function elastic_mu(ph) result(mu)
-
-  real(pReal) :: mu
-  integer, intent(in) :: ph
-
-
-  mu = param(ph)%mu
-
-end function elastic_mu
-
-module function elastic_nu(ph) result(nu)
-
-  real(pReal) :: nu
-  integer, intent(in) :: ph
-
-
-  nu = param(ph)%nu
-
-end function elastic_nu
 
 end submodule elastic

src/phase_mechanical_plastic.f90

@@ -222,7 +222,7 @@ contains
 module subroutine plastic_init
 
 
-  print'(/,a)', ' <<<+-  phase:mechanical:plastic init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:plastic init  -+>>>'
 
   where(plastic_none_init())              phase_plasticity = PLASTICITY_NONE_ID
   where(plastic_isotropic_init())         phase_plasticity = PLASTICITY_ISOTROPIC_ID
@@ -262,40 +262,43 @@ module subroutine plastic_LpAndItsTangents(Lp, dLp_dS, dLp_dFi, &
     i, j
 
 
-  Mp = matmul(matmul(transpose(Fi),Fi),S)
+  if (phase_plasticity(ph) == PLASTICITY_NONE_ID) then
+    Lp      = 0.0_pReal
+    dLp_dFi = 0.0_pReal
+    dLp_dS  = 0.0_pReal
+  else
 
+    Mp = matmul(matmul(transpose(Fi),Fi),S)
 
-  plasticType: select case (phase_plasticity(ph))
+    plasticType: select case (phase_plasticity(ph))
 
-    case (PLASTICITY_NONE_ID) plasticType
+      case (PLASTICITY_ISOTROPIC_ID) plasticType
-      Lp = 0.0_pReal
+        call isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
-      dLp_dMp = 0.0_pReal
 
-    case (PLASTICITY_ISOTROPIC_ID) plasticType
+      case (PLASTICITY_PHENOPOWERLAW_ID) plasticType
-      call isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
+        call phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
 
-    case (PLASTICITY_PHENOPOWERLAW_ID) plasticType
+      case (PLASTICITY_KINEHARDENING_ID) plasticType
-      call phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
+        call kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
 
-    case (PLASTICITY_KINEHARDENING_ID) plasticType
+      case (PLASTICITY_NONLOCAL_ID) plasticType
-      call kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
+        call nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp, thermal_T(ph,en),ph,en)
 
-    case (PLASTICITY_NONLOCAL_ID) plasticType
+      case (PLASTICITY_DISLOTWIN_ID) plasticType
-      call nonlocal_LpAndItsTangent(Lp,dLp_dMp,Mp, thermal_T(ph,en),ph,en)
+        call dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp, thermal_T(ph,en),ph,en)
 
-    case (PLASTICITY_DISLOTWIN_ID) plasticType
+      case (PLASTICITY_DISLOTUNGSTEN_ID) plasticType
-      call dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp, thermal_T(ph,en),ph,en)
+        call dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp, thermal_T(ph,en),ph,en)
 
-    case (PLASTICITY_DISLOTUNGSTEN_ID) plasticType
+    end select plasticType
-      call dislotungsten_LpAndItsTangent(Lp,dLp_dMp,Mp, thermal_T(ph,en),ph,en)
 
-  end select plasticType
+    do i=1,3; do j=1,3
+      dLp_dFi(i,j,1:3,1:3) = matmul(matmul(Fi,S),transpose(dLp_dMp(i,j,1:3,1:3))) + &
+                             matmul(matmul(Fi,dLp_dMp(i,j,1:3,1:3)),S)
+      dLp_dS(i,j,1:3,1:3)  = matmul(matmul(transpose(Fi),Fi),dLp_dMp(i,j,1:3,1:3))                     ! ToDo: @PS: why not:   dLp_dMp:(FiT Fi)
+    end do; end do
 
-  do i=1,3; do j=1,3
+  end if
-    dLp_dFi(i,j,1:3,1:3) = matmul(matmul(Fi,S),transpose(dLp_dMp(i,j,1:3,1:3))) + &
-                           matmul(matmul(Fi,dLp_dMp(i,j,1:3,1:3)),S)
-    dLp_dS(i,j,1:3,1:3)  = matmul(matmul(transpose(Fi),Fi),dLp_dMp(i,j,1:3,1:3))                     ! ToDo: @PS: why not:   dLp_dMp:(FiT Fi)
-  enddo; enddo
 
 end subroutine plastic_LpAndItsTangents
 
@@ -318,32 +321,34 @@ module function plastic_dotState(subdt,co,ip,el,ph,en) result(broken)
   logical :: broken
 
 
-  Mp = matmul(matmul(transpose(phase_mechanical_Fi(ph)%data(1:3,1:3,en)),&
+  if (phase_plasticity(ph) /= PLASTICITY_NONE_ID) then
-                     phase_mechanical_Fi(ph)%data(1:3,1:3,en)),phase_mechanical_S(ph)%data(1:3,1:3,en))
+    Mp = matmul(matmul(transpose(phase_mechanical_Fi(ph)%data(1:3,1:3,en)),&
+                       phase_mechanical_Fi(ph)%data(1:3,1:3,en)),phase_mechanical_S(ph)%data(1:3,1:3,en))
 
-  plasticType: select case (phase_plasticity(ph))
+    plasticType: select case (phase_plasticity(ph))
 
-    case (PLASTICITY_ISOTROPIC_ID) plasticType
+      case (PLASTICITY_ISOTROPIC_ID) plasticType
-      call isotropic_dotState(Mp,ph,en)
+        call isotropic_dotState(Mp,ph,en)
 
-    case (PLASTICITY_PHENOPOWERLAW_ID) plasticType
+      case (PLASTICITY_PHENOPOWERLAW_ID) plasticType
-      call phenopowerlaw_dotState(Mp,ph,en)
+        call phenopowerlaw_dotState(Mp,ph,en)
 
-    case (PLASTICITY_KINEHARDENING_ID) plasticType
+      case (PLASTICITY_KINEHARDENING_ID) plasticType
-      call plastic_kinehardening_dotState(Mp,ph,en)
+        call plastic_kinehardening_dotState(Mp,ph,en)
 
-    case (PLASTICITY_DISLOTWIN_ID) plasticType
+      case (PLASTICITY_DISLOTWIN_ID) plasticType
-      call dislotwin_dotState(Mp,thermal_T(ph,en),ph,en)
+        call dislotwin_dotState(Mp,thermal_T(ph,en),ph,en)
 
-    case (PLASTICITY_DISLOTUNGSTEN_ID) plasticType
+      case (PLASTICITY_DISLOTUNGSTEN_ID) plasticType
-      call dislotungsten_dotState(Mp,thermal_T(ph,en),ph,en)
+        call dislotungsten_dotState(Mp,thermal_T(ph,en),ph,en)
+
+      case (PLASTICITY_NONLOCAL_ID) plasticType
+        call nonlocal_dotState(Mp,thermal_T(ph,en),subdt,ph,en,ip,el)
+    end select plasticType
+  end if
 
-    case (PLASTICITY_NONLOCAL_ID) plasticType
-      call nonlocal_dotState(Mp,thermal_T(ph,en),subdt,ph,en,ip,el)
-  end select plasticType
   broken = any(IEEE_is_NaN(plasticState(ph)%dotState(:,en)))
 
-
 end function plastic_dotState
 
 
@@ -390,8 +395,7 @@ module function plastic_deltaState(ph, en) result(broken)
   integer, intent(in) :: &
     ph, &
     en
-  logical :: &
+  logical :: broken
-    broken
 
   real(pReal),               dimension(3,3) :: &
     Mp
@@ -399,35 +403,34 @@ module function plastic_deltaState(ph, en) result(broken)
     myOffset, &
     mySize
 
+  broken = .false.
 
-  Mp = matmul(matmul(transpose(phase_mechanical_Fi(ph)%data(1:3,1:3,en)),&
+  select case (phase_plasticity(ph))
-                     phase_mechanical_Fi(ph)%data(1:3,1:3,en)),phase_mechanical_S(ph)%data(1:3,1:3,en))
+    case (PLASTICITY_NONLOCAL_ID,PLASTICITY_KINEHARDENING_ID)
 
-  plasticType: select case (phase_plasticity(ph))
+      Mp = matmul(matmul(transpose(phase_mechanical_Fi(ph)%data(1:3,1:3,en)),&
+                         phase_mechanical_Fi(ph)%data(1:3,1:3,en)),&
+                  phase_mechanical_S(ph)%data(1:3,1:3,en))
+
+      plasticType: select case (phase_plasticity(ph))
+
+        case (PLASTICITY_KINEHARDENING_ID) plasticType
+          call plastic_kinehardening_deltaState(Mp,ph,en)
+
+        case (PLASTICITY_NONLOCAL_ID) plasticType
+          call plastic_nonlocal_deltaState(Mp,ph,en)
+
+      end select plasticType
 
-    case (PLASTICITY_KINEHARDENING_ID) plasticType
-      call plastic_kinehardening_deltaState(Mp,ph,en)
       broken = any(IEEE_is_NaN(plasticState(ph)%deltaState(:,en)))
-
+      if (.not. broken) then
-    case (PLASTICITY_NONLOCAL_ID) plasticType
-      call plastic_nonlocal_deltaState(Mp,ph,en)
-      broken = any(IEEE_is_NaN(plasticState(ph)%deltaState(:,en)))
-
-    case default
-      broken = .false.
-
-  end select plasticType
-
-  if(.not. broken) then
-    select case(phase_plasticity(ph))
-      case (PLASTICITY_NONLOCAL_ID,PLASTICITY_KINEHARDENING_ID)
-
         myOffset = plasticState(ph)%offsetDeltaState
         mySize   = plasticState(ph)%sizeDeltaState
         plasticState(ph)%state(myOffset + 1:myOffset + mySize,en) = &
         plasticState(ph)%state(myOffset + 1:myOffset + mySize,en) + plasticState(ph)%deltaState(1:mySize,en)
-    end select
+      end if
-  endif
+
+  end select
 
 end function plastic_deltaState
 
@@ -435,7 +438,7 @@ end function plastic_deltaState
 !--------------------------------------------------------------------------------------------------
 !> @brief checks if a plastic module is active or not
 !--------------------------------------------------------------------------------------------------
-function plastic_active(plastic_label)  result(active_plastic)
+function plastic_active(plastic_label) result(active_plastic)
 
   character(len=*), intent(in)       :: plastic_label                                               !< type of plasticity model
   logical, dimension(:), allocatable :: active_plastic
@@ -453,7 +456,7 @@ function plastic_active(plastic_label)  result(active_plastic)
     phase => phases%get(ph)
     mech  => phase%get('mechanical')
     pl    => mech%get('plastic',defaultVal = emptyDict)
-    if(pl%get_asString('type',defaultVal='none') == plastic_label) active_plastic(ph) = .true.
+    active_plastic(ph) = pl%get_asString('type',defaultVal='none') == plastic_label
   enddo
 
 end function plastic_active

src/phase_mechanical_plastic_dislotungsten.f90

@@ -7,13 +7,9 @@
 !--------------------------------------------------------------------------------------------------
 submodule(phase:plastic) dislotungsten
 
-  real(pReal), parameter :: &
-    kB = 1.38e-23_pReal                                                                             !< Boltzmann constant in J/Kelvin
-
   type :: tParameters
     real(pReal) :: &
       D    = 1.0_pReal, &                                                                           !< grain size
-      mu   = 1.0_pReal, &                                                                           !< equivalent shear modulus
       D_0  = 1.0_pReal, &                                                                           !< prefactor for self-diffusion coefficient
       Q_cl = 1.0_pReal                                                                              !< activation energy for dislocation climb
     real(pReal),               allocatable, dimension(:) :: &
@@ -99,13 +95,13 @@ module function plastic_dislotungsten_init() result(myPlasticity)
 
 
   myPlasticity = plastic_active('dislotungsten')
-  if(count(myPlasticity) == 0) return
+  if (count(myPlasticity) == 0) return
 
-  print'(/,a)', ' <<<+-  phase:mechanical:plastic:dislotungsten init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:plastic:dislotungsten init  -+>>>'
-  print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
+  print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
 
-  print*, 'D. Cereceda et al., International Journal of Plasticity 78:242–256, 2016'
+  print'(/,1x,a)', 'D. Cereceda et al., International Journal of Plasticity 78:242–256, 2016'
-  print*, 'https://doi.org/10.1016/j.ijplas.2015.09.002'
+  print'(  1x,a)', 'https://doi.org/10.1016/j.ijplas.2015.09.002'
 
 
   phases => config_material%get('phase')
@@ -116,7 +112,7 @@ module function plastic_dislotungsten_init() result(myPlasticity)
 
 
   do ph = 1, phases%length
-    if(.not. myPlasticity(ph)) cycle
+    if (.not. myPlasticity(ph)) cycle
 
     associate(prm => param(ph), dot => dotState(ph), stt => state(ph), dst => dependentState(ph))
 
@@ -130,8 +126,6 @@ module function plastic_dislotungsten_init() result(myPlasticity)
     prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
 #endif
 
-    prm%mu = elastic_mu(ph)
-
 !--------------------------------------------------------------------------------------------------
 ! slip related parameters
     N_sl         = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray)
@@ -243,7 +237,7 @@ module function plastic_dislotungsten_init() result(myPlasticity)
     stt%gamma_sl => plasticState(ph)%state(startIndex:endIndex,:)
     dot%gamma_sl => plasticState(ph)%dotState(startIndex:endIndex,:)
     plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
-    if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
 
     allocate(dst%Lambda_sl(prm%sum_N_sl,Nmembers), source=0.0_pReal)
     allocate(dst%tau_pass(prm%sum_N_sl,Nmembers),  source=0.0_pReal)
@@ -324,10 +318,13 @@ module subroutine dislotungsten_dotState(Mp,T,ph,en)
     dot_rho_dip_formation, &
     dot_rho_dip_climb, &
     d_hat
-
+  real(pReal) :: &
+    mu
 
   associate(prm => param(ph), stt => state(ph), dot => dotState(ph), dst => dependentState(ph))
 
+    mu = elastic_mu(ph,en)
+
     call kinetics(Mp,T,ph,en,&
                   dot_gamma_pos,dot_gamma_neg, &
                   tau_pos_out = tau_pos,tau_neg_out = tau_neg)
@@ -338,13 +335,13 @@ module subroutine dislotungsten_dotState(Mp,T,ph,en)
       dot_rho_dip_formation = 0.0_pReal
       dot_rho_dip_climb     = 0.0_pReal
     else where
-      d_hat = math_clip(3.0_pReal*prm%mu*prm%b_sl/(16.0_pReal*PI*abs(tau_pos+tau_neg)*0.5_pReal), &
+      d_hat = math_clip(3.0_pReal*mu*prm%b_sl/(16.0_pReal*PI*abs(tau_pos+tau_neg)*0.5_pReal), &
                         prm%d_caron, &                                                              ! lower limit
                         dst%Lambda_sl(:,en))                                                        ! upper limit
       dot_rho_dip_formation = merge(2.0_pReal*(d_hat-prm%d_caron)*stt%rho_mob(:,en)*dot%gamma_sl(:,en)/prm%b_sl, &
                                     0.0_pReal, &
                                     prm%dipoleformation)
-      v_cl = (3.0_pReal*prm%mu*prm%D_0*exp(-prm%Q_cl/(kB*T))*prm%f_at/(2.0_pReal*PI*kB*T)) &
+      v_cl = (3.0_pReal*mu*prm%D_0*exp(-prm%Q_cl/(K_B*T))*prm%f_at/(2.0_pReal*PI*K_B*T)) &
            * (1.0_pReal/(d_hat+prm%d_caron))
       dot_rho_dip_climb = (4.0_pReal*v_cl*stt%rho_dip(:,en))/(d_hat-prm%d_caron)                    ! ToDo: Discuss with Franz: Stress dependency?
     end where
@@ -376,7 +373,7 @@ module subroutine dislotungsten_dependentState(ph,en)
 
   associate(prm => param(ph), stt => state(ph), dst => dependentState(ph))
 
-    dst%tau_pass(:,en) = prm%mu*prm%b_sl &
+    dst%tau_pass(:,en) = elastic_mu(ph,en)*prm%b_sl &
                        * sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
 
     Lambda_sl_inv = 1.0_pReal/prm%D &
@@ -475,7 +472,7 @@ pure subroutine kinetics(Mp,T,ph,en, &
     if (present(tau_pos_out)) tau_pos_out = tau_pos
     if (present(tau_neg_out)) tau_neg_out = tau_neg
 
-    associate(BoltzmannRatio  => prm%Q_s/(kB*T), &
+    associate(BoltzmannRatio  => prm%Q_s/(K_B*T), &
               b_rho_half      => stt%rho_mob(:,en) * prm%b_sl * 0.5_pReal, &
               effectiveLength => dst%Lambda_sl(:,en) - prm%w)
 

src/phase_mechanical_plastic_dislotwin.f90

@@ -9,13 +9,8 @@
 !--------------------------------------------------------------------------------------------------
 submodule(phase:plastic) dislotwin
 
-  real(pReal), parameter :: &
-    kB = 1.38e-23_pReal                                                                             !< Boltzmann constant in J/Kelvin
-
   type :: tParameters
     real(pReal) :: &
-      mu                  = 1.0_pReal, &                                                            !< equivalent shear modulus
-      nu                  = 1.0_pReal, &                                                            !< equivalent shear Poisson's ratio
       Q_cl                = 1.0_pReal, &                                                            !< activation energy for dislocation climb
       omega               = 1.0_pReal, &                                                            !< frequency factor for dislocation climb
       D                   = 1.0_pReal, &                                                            !< grain size
@@ -33,7 +28,9 @@ submodule(phase:plastic) dislotwin
       delta_G             = 1.0_pReal, &                                                            !< Free energy difference between austensite and martensite
       i_tr                = 1.0_pReal, &                                                            !< adjustment parameter to calculate MFP for transformation
       h                   = 1.0_pReal, &                                                            !< Stack height of hex nucleus
-      T_ref               = 0.0_pReal
+      T_ref               = T_ROOM, &
+      a_cI                = 1.0_pReal, &
+      a_cF                = 1.0_pReal
     real(pReal),                            dimension(2) :: &
       Gamma_sf = 0.0_pReal
     real(pReal),               allocatable, dimension(:) :: &
@@ -62,20 +59,22 @@ submodule(phase:plastic) dislotwin
       h_sl_tr, &                                                                                    !< components of slip-trans interaction matrix
       h_tr_tr, &                                                                                    !< components of trans-trans interaction matrix
       n0_sl, &                                                                                      !< slip system normal
-      forestProjection, &
+      forestProjection
-      C66
     real(pReal),               allocatable, dimension(:,:,:) :: &
       P_sl, &
       P_tw, &
-      P_tr, &
+      P_tr
-      C66_tw, &
-      C66_tr
     integer :: &
       sum_N_sl, &                                                                                   !< total number of active slip system
       sum_N_tw, &                                                                                   !< total number of active twin system
       sum_N_tr                                                                                      !< total number of active transformation system
+    integer,                   allocatable, dimension(:)   :: &
+      N_tw, &
+      N_tr
     integer,                   allocatable, dimension(:,:) :: &
       fcc_twinNucleationSlipPair                                                                    ! ToDo: Better name? Is also use for trans
+    character(len=:),          allocatable                 :: &
+      lattice_tr
     character(len=pStringLen), allocatable, dimension(:) :: &
       output
     logical :: &
@@ -134,7 +133,7 @@ module function plastic_dislotwin_init() result(myPlasticity)
     sizeState, sizeDotState, &
     startIndex, endIndex
   integer,     dimension(:), allocatable :: &
-    N_sl, N_tw, N_tr
+    N_sl
   real(pReal), allocatable, dimension(:) :: &
     rho_mob_0, &                                                                                    !< initial unipolar dislocation density per slip system
     rho_dip_0                                                                                       !< initial dipole dislocation density per slip system
@@ -148,19 +147,19 @@ module function plastic_dislotwin_init() result(myPlasticity)
 
 
   myPlasticity = plastic_active('dislotwin')
-  if(count(myPlasticity) == 0) return
+  if (count(myPlasticity) == 0) return
 
-  print'(/,a)', ' <<<+-  phase:mechanical:plastic:dislotwin init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:plastic:dislotwin init  -+>>>'
-  print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
+  print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
 
-  print*, 'A. Ma and F. Roters, Acta Materialia 52(12):3603–3612, 2004'
+  print'(/,1x,a)', 'A. Ma and F. Roters, Acta Materialia 52(12):3603–3612, 2004'
-  print*, 'https://doi.org/10.1016/j.actamat.2004.04.012'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.1016/j.actamat.2004.04.012'//IO_EOL
 
-  print*, 'F. Roters et al., Computational Materials Science 39:91–95, 2007'
+  print'(/,1x,a)', 'F. Roters et al., Computational Materials Science 39:91–95, 2007'
-  print*, 'https://doi.org/10.1016/j.commatsci.2006.04.014'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.1016/j.commatsci.2006.04.014'//IO_EOL
 
-  print*, 'S.L. Wong et al., Acta Materialia 118:140–151, 2016'
+  print'(/,1x,a)', 'S.L. Wong et al., Acta Materialia 118:140–151, 2016'
-  print*, 'https://doi.org/10.1016/j.actamat.2016.07.032'
+  print'(  1x,a)', 'https://doi.org/10.1016/j.actamat.2016.07.032'
 
 
   phases => config_material%get('phase')
@@ -171,7 +170,7 @@ module function plastic_dislotwin_init() result(myPlasticity)
 
 
   do ph = 1, phases%length
-    if(.not. myPlasticity(ph)) cycle
+    if (.not. myPlasticity(ph)) cycle
 
     associate(prm => param(ph), dot => dotState(ph), stt => state(ph), dst => dependentState(ph))
 
@@ -185,10 +184,6 @@ module function plastic_dislotwin_init() result(myPlasticity)
     prm%output = pl%get_as1dString('output',defaultVal=emptyStringArray)
 #endif
 
-    ! This data is read in already in lattice
-    prm%mu  = elastic_mu(ph)
-    prm%nu  = elastic_nu(ph)
-    prm%C66 = elastic_C66(ph)
 
 !--------------------------------------------------------------------------------------------------
 ! slip related parameters
@@ -256,39 +251,37 @@ module function plastic_dislotwin_init() result(myPlasticity)
       rho_mob_0 = emptyRealArray; rho_dip_0 = emptyRealArray
       allocate(prm%b_sl,prm%Q_sl,prm%v_0,prm%i_sl,prm%p,prm%q,prm%B,source=emptyRealArray)
       allocate(prm%forestProjection(0,0),prm%h_sl_sl(0,0))
-    endif slipActive
+    end if slipActive
 
 !--------------------------------------------------------------------------------------------------
 ! twin related parameters
-    N_tw         = pl%get_as1dInt('N_tw', defaultVal=emptyIntArray)
+    prm%N_tw     = pl%get_as1dInt('N_tw', defaultVal=emptyIntArray)
-    prm%sum_N_tw = sum(abs(N_tw))
+    prm%sum_N_tw = sum(abs(prm%N_tw))
     twinActive: if (prm%sum_N_tw > 0) then
-      prm%systems_tw = lattice_labels_twin(N_tw,phase_lattice(ph))
+      prm%systems_tw = lattice_labels_twin(prm%N_tw,phase_lattice(ph))
-      prm%P_tw  = lattice_SchmidMatrix_twin(N_tw,phase_lattice(ph),phase_cOverA(ph))
+      prm%P_tw  = lattice_SchmidMatrix_twin(prm%N_tw,phase_lattice(ph),phase_cOverA(ph))
-      prm%h_tw_tw   = lattice_interaction_TwinByTwin(N_tw,pl%get_as1dFloat('h_tw-tw'), &
+      prm%h_tw_tw   = lattice_interaction_TwinByTwin(prm%N_tw,pl%get_as1dFloat('h_tw-tw'), &
                                                      phase_lattice(ph))
 
-      prm%b_tw      = pl%get_as1dFloat('b_tw',     requiredSize=size(N_tw))
+      prm%b_tw      = pl%get_as1dFloat('b_tw',     requiredSize=size(prm%N_tw))
-      prm%t_tw      = pl%get_as1dFloat('t_tw',     requiredSize=size(N_tw))
+      prm%t_tw      = pl%get_as1dFloat('t_tw',     requiredSize=size(prm%N_tw))
-      prm%r         = pl%get_as1dFloat('p_tw',     requiredSize=size(N_tw))
+      prm%r         = pl%get_as1dFloat('p_tw',     requiredSize=size(prm%N_tw))
 
       prm%x_c_tw    = pl%get_asFloat('x_c_tw')
       prm%L_tw      = pl%get_asFloat('L_tw')
       prm%i_tw      = pl%get_asFloat('i_tw')
 
-      prm%gamma_char= lattice_characteristicShear_Twin(N_tw,phase_lattice(ph),phase_cOverA(ph))
+      prm%gamma_char= lattice_characteristicShear_Twin(prm%N_tw,phase_lattice(ph),phase_cOverA(ph))
-
-      prm%C66_tw    = lattice_C66_twin(N_tw,prm%C66,phase_lattice(ph),phase_cOverA(ph))
 
       if (.not. prm%fccTwinTransNucleation) then
         prm%dot_N_0_tw = pl%get_as1dFloat('dot_N_0_tw')
-        prm%dot_N_0_tw = math_expand(prm%dot_N_0_tw,N_tw)
+        prm%dot_N_0_tw = math_expand(prm%dot_N_0_tw,prm%N_tw)
       endif
 
       ! expand: family => system
-      prm%b_tw = math_expand(prm%b_tw,N_tw)
+      prm%b_tw = math_expand(prm%b_tw,prm%N_tw)
-      prm%t_tw = math_expand(prm%t_tw,N_tw)
+      prm%t_tw = math_expand(prm%t_tw,prm%N_tw)
-      prm%r    = math_expand(prm%r,N_tw)
+      prm%r    = math_expand(prm%r,prm%N_tw)
 
       ! sanity checks
       if (    prm%x_c_tw        < 0.0_pReal)  extmsg = trim(extmsg)//' x_c_tw'
@@ -299,47 +292,46 @@ module function plastic_dislotwin_init() result(myPlasticity)
       if (any(prm%r             < 0.0_pReal)) extmsg = trim(extmsg)//' p_tw'
       if (.not. prm%fccTwinTransNucleation) then
         if (any(prm%dot_N_0_tw  < 0.0_pReal)) extmsg = trim(extmsg)//' dot_N_0_tw'
-      endif
+      end if
     else twinActive
       allocate(prm%gamma_char,prm%b_tw,prm%dot_N_0_tw,prm%t_tw,prm%r,source=emptyRealArray)
       allocate(prm%h_tw_tw(0,0))
-    endif twinActive
+    end if twinActive
 
 !--------------------------------------------------------------------------------------------------
 ! transformation related parameters
-    N_tr         = pl%get_as1dInt('N_tr', defaultVal=emptyIntArray)
+    prm%N_tr         = pl%get_as1dInt('N_tr', defaultVal=emptyIntArray)
-    prm%sum_N_tr = sum(abs(N_tr))
+    prm%sum_N_tr = sum(abs(prm%N_tr))
     transActive: if (prm%sum_N_tr > 0) then
       prm%b_tr = pl%get_as1dFloat('b_tr')
-      prm%b_tr = math_expand(prm%b_tr,N_tr)
+      prm%b_tr = math_expand(prm%b_tr,prm%N_tr)
 
       prm%h             = pl%get_asFloat('h',       defaultVal=0.0_pReal) ! ToDo: How to handle that???
       prm%i_tr          = pl%get_asFloat('i_tr',    defaultVal=0.0_pReal) ! ToDo: How to handle that???
       prm%delta_G       = pl%get_asFloat('delta_G')
       prm%x_c_tr        = pl%get_asFloat('x_c_tr',  defaultVal=0.0_pReal) ! ToDo: How to handle that???
       prm%L_tr          = pl%get_asFloat('L_tr')
+      prm%a_cI          = pl%get_asFloat('a_cI',    defaultVal=0.0_pReal)
+      prm%a_cF          = pl%get_asFloat('a_cF',    defaultVal=0.0_pReal)
 
-      prm%h_tr_tr = lattice_interaction_TransByTrans(N_tr,pl%get_as1dFloat('h_tr-tr'),&
+      prm%lattice_tr    = pl%get_asString('lattice_tr')
+
+      prm%h_tr_tr = lattice_interaction_TransByTrans(prm%N_tr,pl%get_as1dFloat('h_tr-tr'),&
                                                      phase_lattice(ph))
 
-      prm%C66_tr  = lattice_C66_trans(N_tr,prm%C66,pl%get_asString('lattice_tr'), &
+      prm%P_tr    = lattice_SchmidMatrix_trans(prm%N_tr,prm%lattice_tr, &
-                                      0.0_pReal, &
-                                      pl%get_asFloat('a_cI', defaultVal=0.0_pReal), &
-                                      pl%get_asFloat('a_cF', defaultVal=0.0_pReal))
-
-      prm%P_tr    = lattice_SchmidMatrix_trans(N_tr,pl%get_asString('lattice_tr'), &
                                                0.0_pReal, &
-                                               pl%get_asFloat('a_cI', defaultVal=0.0_pReal), &
+                                               prm%a_cI, &
-                                               pl%get_asFloat('a_cF', defaultVal=0.0_pReal))
+                                               prm%a_cF)
 
       if (phase_lattice(ph) /= 'cF') then
         prm%dot_N_0_tr = pl%get_as1dFloat('dot_N_0_tr')
-        prm%dot_N_0_tr = math_expand(prm%dot_N_0_tr,N_tr)
+        prm%dot_N_0_tr = math_expand(prm%dot_N_0_tr,prm%N_tr)
       endif
       prm%t_tr = pl%get_as1dFloat('t_tr')
-      prm%t_tr = math_expand(prm%t_tr,N_tr)
+      prm%t_tr = math_expand(prm%t_tr,prm%N_tr)
       prm%s    = pl%get_as1dFloat('p_tr',defaultVal=[0.0_pReal])
-      prm%s    = math_expand(prm%s,N_tr)
+      prm%s    = math_expand(prm%s,prm%N_tr)
 
       ! sanity checks
       if (    prm%x_c_tr        < 0.0_pReal)  extmsg = trim(extmsg)//' x_c_tr'
@@ -349,11 +341,11 @@ module function plastic_dislotwin_init() result(myPlasticity)
       if (any(prm%s             < 0.0_pReal)) extmsg = trim(extmsg)//' p_tr'
       if (phase_lattice(ph) /= 'cF') then
         if (any(prm%dot_N_0_tr  < 0.0_pReal)) extmsg = trim(extmsg)//' dot_N_0_tr'
-      endif
+      end if
     else transActive
       allocate(prm%s,prm%b_tr,prm%t_tr,prm%dot_N_0_tr,source=emptyRealArray)
       allocate(prm%h_tr_tr(0,0))
-    endif transActive
+    end if transActive
 
 !--------------------------------------------------------------------------------------------------
 ! shearband related parameters
@@ -369,11 +361,11 @@ module function plastic_dislotwin_init() result(myPlasticity)
       if (prm%E_sb          <  0.0_pReal) extmsg = trim(extmsg)//' Q_sb'
       if (prm%p_sb          <= 0.0_pReal) extmsg = trim(extmsg)//' p_sb'
       if (prm%q_sb          <= 0.0_pReal) extmsg = trim(extmsg)//' q_sb'
-    endif
+    end if
 
 !--------------------------------------------------------------------------------------------------
 ! parameters required for several mechanisms and their interactions
-    if(prm%sum_N_sl + prm%sum_N_tw + prm%sum_N_tw > 0) &
+    if (prm%sum_N_sl + prm%sum_N_tw + prm%sum_N_tw > 0) &
       prm%D = pl%get_asFloat('D')
 
     if (prm%sum_N_tw + prm%sum_N_tr > 0) &
@@ -383,18 +375,18 @@ module function plastic_dislotwin_init() result(myPlasticity)
       prm%T_ref       = pl%get_asFloat('T_ref')
       prm%Gamma_sf(1) = pl%get_asFloat('Gamma_sf')
       prm%Gamma_sf(2) = pl%get_asFloat('Gamma_sf,T',defaultVal=0.0_pReal)
-    endif
+    end if
 
     slipAndTwinActive: if (prm%sum_N_sl * prm%sum_N_tw > 0) then
-      prm%h_sl_tw = lattice_interaction_SlipByTwin(N_sl,N_tw,pl%get_as1dFloat('h_sl-tw'), &
+      prm%h_sl_tw = lattice_interaction_SlipByTwin(N_sl,prm%N_tw,pl%get_as1dFloat('h_sl-tw'), &
                                                    phase_lattice(ph))
-      if (prm%fccTwinTransNucleation .and. size(N_tw) /= 1) extmsg = trim(extmsg)//' N_tw: nucleation'
+      if (prm%fccTwinTransNucleation .and. size(prm%N_tw) /= 1) extmsg = trim(extmsg)//' N_tw: nucleation'
     endif slipAndTwinActive
 
     slipAndTransActive: if (prm%sum_N_sl * prm%sum_N_tr > 0) then
-      prm%h_sl_tr = lattice_interaction_SlipByTrans(N_sl,N_tr,pl%get_as1dFloat('h_sl-tr'), &
+      prm%h_sl_tr = lattice_interaction_SlipByTrans(N_sl,prm%N_tr,pl%get_as1dFloat('h_sl-tr'), &
                                                     phase_lattice(ph))
-      if (prm%fccTwinTransNucleation .and. size(N_tr) /= 1) extmsg = trim(extmsg)//' N_tr: nucleation'
+      if (prm%fccTwinTransNucleation .and. size(prm%N_tr) /= 1) extmsg = trim(extmsg)//' N_tr: nucleation'
     endif slipAndTransActive
 
 !--------------------------------------------------------------------------------------------------
@@ -430,7 +422,7 @@ module function plastic_dislotwin_init() result(myPlasticity)
     stt%gamma_sl=>plasticState(ph)%state(startIndex:endIndex,:)
     dot%gamma_sl=>plasticState(ph)%dotState(startIndex:endIndex,:)
     plasticState(ph)%atol(startIndex:endIndex) = pl%get_asFloat('atol_gamma',defaultVal=1.0e-6_pReal)
-    if(any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
+    if (any(plasticState(ph)%atol(startIndex:endIndex) < 0.0_pReal)) extmsg = trim(extmsg)//' atol_gamma'
 
     startIndex = endIndex + 1
     endIndex   = endIndex + prm%sum_N_tw
@@ -465,7 +457,7 @@ module function plastic_dislotwin_init() result(myPlasticity)
 !  exit if any parameter is out of range
     if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(dislotwin)')
 
-  enddo
+  end do
 
 end function plastic_dislotwin_init
 
@@ -478,27 +470,40 @@ module function plastic_dislotwin_homogenizedC(ph,en) result(homogenizedC)
   integer,     intent(in) :: &
     ph, en
   real(pReal), dimension(6,6) :: &
-    homogenizedC
+    homogenizedC, &
-
+    C
+  real(pReal), dimension(:,:,:), allocatable :: &
+    C66_tw, &
+    C66_tr
   integer :: i
   real(pReal) :: f_unrotated
 
 
+  C = elastic_C66(ph,en)
+
   associate(prm => param(ph), stt => state(ph))
 
     f_unrotated = 1.0_pReal &
                 - sum(stt%f_tw(1:prm%sum_N_tw,en)) &
                 - sum(stt%f_tr(1:prm%sum_N_tr,en))
 
-    homogenizedC = f_unrotated * prm%C66
+    homogenizedC = f_unrotated * C
-    do i=1,prm%sum_N_tw
+
-      homogenizedC = homogenizedC &
+    twinActive: if (prm%sum_N_tw > 0) then
-                   + stt%f_tw(i,en)*prm%C66_tw(1:6,1:6,i)
+      C66_tw    = lattice_C66_twin(prm%N_tw,C,phase_lattice(ph),phase_cOverA(ph))
-    enddo
+      do i=1,prm%sum_N_tw
-    do i=1,prm%sum_N_tr
+        homogenizedC = homogenizedC &
-      homogenizedC = homogenizedC &
+                     + stt%f_tw(i,en)*C66_tw(1:6,1:6,i)
-                   + stt%f_tr(i,en)*prm%C66_tr(1:6,1:6,i)
+      end do
-    enddo
+     end if twinActive
+
+    transActive: if (prm%sum_N_tr > 0) then
+      C66_tr    = lattice_C66_trans(prm%N_tr,C,prm%lattice_tr,0.0_pReal,prm%a_cI,prm%a_cF)
+      do i=1,prm%sum_N_tr
+        homogenizedC = homogenizedC &
+                     + stt%f_tr(i,en)*C66_tr(1:6,1:6,i)
+      end do
+    end if transActive
 
   end associate
 
@@ -566,7 +571,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,en)
     forall (k=1:3,l=1:3,m=1:3,n=1:3) &
       dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
                        + ddot_gamma_dtau_sl(i) * prm%P_sl(k,l,i) * prm%P_sl(m,n,i)
-  enddo slipContribution
+  end do slipContribution
 
   call kinetics_tw(Mp,T,dot_gamma_sl,ph,en,dot_gamma_tw,ddot_gamma_dtau_tw)
   twinContibution: do i = 1, prm%sum_N_tw
@@ -574,7 +579,7 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,en)
     forall (k=1:3,l=1:3,m=1:3,n=1:3) &
       dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
                        + ddot_gamma_dtau_tw(i)* prm%P_tw(k,l,i)*prm%P_tw(m,n,i)
-  enddo twinContibution
+  end do twinContibution
 
   call kinetics_tr(Mp,T,dot_gamma_sl,ph,en,dot_gamma_tr,ddot_gamma_dtau_tr)
   transContibution: do i = 1, prm%sum_N_tr
@@ -582,14 +587,14 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,en)
     forall (k=1:3,l=1:3,m=1:3,n=1:3) &
       dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
                        + ddot_gamma_dtau_tr(i)* prm%P_tr(k,l,i)*prm%P_tr(m,n,i)
-  enddo transContibution
+  end do transContibution
 
   Lp      = Lp      * f_unrotated
   dLp_dMp = dLp_dMp * f_unrotated
 
-  shearBandingContribution: if(dNeq0(prm%v_sb)) then
+  shearBandingContribution: if (dNeq0(prm%v_sb)) then
 
-    E_kB_T = prm%E_sb/(kB*T)
+    E_kB_T = prm%E_sb/(K_B*T)
     call math_eigh33(eigValues,eigVectors,Mp)                                                       ! is Mp symmetric by design?
 
     do i = 1,6
@@ -608,10 +613,10 @@ module subroutine dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,ph,en)
         forall (k=1:3,l=1:3,m=1:3,n=1:3) &
           dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
                            + ddot_gamma_dtau * P_sb(k,l) * P_sb(m,n)
-      endif significantShearBandStress
+      end if significantShearBandStress
-    enddo
+    end do
 
-  endif shearBandingContribution
+  end if shearBandingContribution
 
   end associate
 
@@ -647,10 +652,15 @@ module subroutine dislotwin_dotState(Mp,T,ph,en)
     dot_gamma_tw
   real(pReal), dimension(param(ph)%sum_N_tr) :: &
     dot_gamma_tr
-
+  real(pReal) :: &
+    mu, &
+    nu
 
   associate(prm => param(ph), stt => state(ph), dot => dotState(ph), dst => dependentState(ph))
 
+    mu = elastic_mu(ph,en)
+    nu = elastic_nu(ph,en)
+
     f_unrotated = 1.0_pReal &
                 - sum(stt%f_tw(1:prm%sum_N_tw,en)) &
                 - sum(stt%f_tr(1:prm%sum_N_tr,en))
@@ -665,7 +675,7 @@ module subroutine dislotwin_dotState(Mp,T,ph,en)
         dot_rho_dip_formation(i) = 0.0_pReal
         dot_rho_dip_climb(i) = 0.0_pReal
       else significantSlipStress
-        d_hat = 3.0_pReal*prm%mu*prm%b_sl(i)/(16.0_pReal*PI*abs(tau))
+        d_hat = 3.0_pReal*mu*prm%b_sl(i)/(16.0_pReal*PI*abs(tau))
         d_hat = math_clip(d_hat, right = dst%Lambda_sl(i,en))
         d_hat = math_clip(d_hat, left  = prm%d_caron(i))
 
@@ -677,18 +687,18 @@ module subroutine dislotwin_dotState(Mp,T,ph,en)
         else
           ! Argon & Moffat, Acta Metallurgica, Vol. 29, pg 293 to 299, 1981
           sigma_cl = dot_product(prm%n0_sl(1:3,i),matmul(Mp,prm%n0_sl(1:3,i)))
-          b_d = merge(24.0_pReal*PI*(1.0_pReal - prm%nu)/(2.0_pReal + prm%nu) &
+          b_d = merge(24.0_pReal*PI*(1.0_pReal - nu)/(2.0_pReal + nu) &
-                        * (prm%Gamma_sf(1) + prm%Gamma_sf(2) * T) / (prm%mu*prm%b_sl(i)), &
+                        * (prm%Gamma_sf(1) + prm%Gamma_sf(2) * T) / (mu*prm%b_sl(i)), &
                       1.0_pReal, &
                       prm%ExtendedDislocations)
-          v_cl = 2.0_pReal*prm%omega*b_d**2.0_pReal*exp(-prm%Q_cl/(kB*T)) &
+          v_cl = 2.0_pReal*prm%omega*b_d**2.0_pReal*exp(-prm%Q_cl/(K_B*T)) &
-               * (exp(abs(sigma_cl)*prm%b_sl(i)**3.0_pReal/(kB*T)) - 1.0_pReal)
+               * (exp(abs(sigma_cl)*prm%b_sl(i)**3.0_pReal/(K_B*T)) - 1.0_pReal)
 
           dot_rho_dip_climb(i) = 4.0_pReal*v_cl*stt%rho_dip(i,en) &
                                / (d_hat-prm%d_caron(i))
-        endif
+        end if
-      endif significantSlipStress
+      end if significantSlipStress
-    enddo slipState
+    end do slipState
 
     dot%rho_mob(:,en) = abs(dot_gamma_sl)/(prm%b_sl*dst%Lambda_sl(:,en)) &
                       - dot_rho_dip_formation &
@@ -732,10 +742,15 @@ module subroutine dislotwin_dependentState(T,ph,en)
     f_over_t_tr
   real(pReal), dimension(:), allocatable :: &
     x0
-
+  real(pReal) :: &
+    mu, &
+    nu
 
   associate(prm => param(ph), stt => state(ph), dst => dependentState(ph))
 
+    mu = elastic_mu(ph,en)
+    nu = elastic_nu(ph,en)
+
     sumf_tw = sum(stt%f_tw(1:prm%sum_N_tw,en))
     sumf_tr = sum(stt%f_tr(1:prm%sum_N_tr,en))
 
@@ -760,24 +775,24 @@ module subroutine dislotwin_dependentState(T,ph,en)
     dst%Lambda_tr(:,en) = prm%i_tr*prm%D/(1.0_pReal+prm%D*inv_lambda_tr_tr)
 
     !* threshold stress for dislocation motion
-    dst%tau_pass(:,en) = prm%mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
+    dst%tau_pass(:,en) = mu*prm%b_sl* sqrt(matmul(prm%h_sl_sl,stt%rho_mob(:,en)+stt%rho_dip(:,en)))
 
     !* threshold stress for growing twin/martensite
     dst%tau_hat_tw(:,en) = Gamma/(3.0_pReal*prm%b_tw) &
-                         + 3.0_pReal*prm%b_tw*prm%mu/(prm%L_tw*prm%b_tw)
+                         + 3.0_pReal*prm%b_tw*mu/(prm%L_tw*prm%b_tw)
     dst%tau_hat_tr(:,en) = Gamma/(3.0_pReal*prm%b_tr) &
-                         + 3.0_pReal*prm%b_tr*prm%mu/(prm%L_tr*prm%b_tr) &
+                         + 3.0_pReal*prm%b_tr*mu/(prm%L_tr*prm%b_tr) &
                          + prm%h*prm%delta_G/(3.0_pReal*prm%b_tr)
 
     dst%V_tw(:,en) = (PI/4.0_pReal)*prm%t_tw*dst%Lambda_tw(:,en)**2.0_pReal
     dst%V_tr(:,en) = (PI/4.0_pReal)*prm%t_tr*dst%Lambda_tr(:,en)**2.0_pReal
 
 
-    x0 = prm%mu*prm%b_tw**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu)      ! ToDo: In the paper, this is the Burgers vector for slip
+    x0 = mu*prm%b_tw**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+nu)/(1.0_pReal-nu)                  ! ToDo: In the paper, this is the Burgers vector for slip
-    dst%tau_r_tw(:,en) = prm%mu*prm%b_tw/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tw)+cos(pi/3.0_pReal)/x0)
+    dst%tau_r_tw(:,en) = mu*prm%b_tw/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tw)+cos(pi/3.0_pReal)/x0)
 
-    x0 = prm%mu*prm%b_tr**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+prm%nu)/(1.0_pReal-prm%nu)      ! ToDo: In the paper, this is the Burgers vector for slip
+    x0 = mu*prm%b_tr**2.0_pReal/(Gamma*8.0_pReal*PI)*(2.0_pReal+nu)/(1.0_pReal-nu)                  ! ToDo: In the paper, this is the Burgers vector for slip
-    dst%tau_r_tr(:,en) = prm%mu*prm%b_tr/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tr)+cos(pi/3.0_pReal)/x0)
+    dst%tau_r_tr(:,en) = mu*prm%b_tr/(2.0_pReal*PI)*(1.0_pReal/(x0+prm%x_c_tr)+cos(pi/3.0_pReal)/x0)
 
   end associate
 
@@ -828,12 +843,12 @@ module subroutine plastic_dislotwin_results(ph,group)
                                        'threshold stress for twinning','Pa',prm%systems_tw)
 
         case('f_tr')
-          if(prm%sum_N_tr>0) call results_writeDataset(stt%f_tr,group,trim(prm%output(ou)), &
+          if (prm%sum_N_tr>0) call results_writeDataset(stt%f_tr,group,trim(prm%output(ou)), &
                                                        'martensite volume fraction','m³/m³')
 
       end select
 
-    enddo
+    end do
 
   end associate
 
@@ -889,7 +904,7 @@ pure subroutine kinetics_sl(Mp,T,ph,en, &
     significantStress: where(tau_eff > tol_math_check)
       stressRatio    = tau_eff/prm%tau_0
       StressRatio_p  = stressRatio** prm%p
-      Q_kB_T = prm%Q_sl/(kB*T)
+      Q_kB_T = prm%Q_sl/(K_B*T)
       v_wait_inverse = exp(Q_kB_T*(1.0_pReal-StressRatio_p)** prm%q) &
                      / prm%v_0
       v_run_inverse  = prm%B/(tau_eff*prm%b_sl)
@@ -911,8 +926,8 @@ pure subroutine kinetics_sl(Mp,T,ph,en, &
 
   end associate
 
-  if(present(ddot_gamma_dtau_sl)) ddot_gamma_dtau_sl = ddot_gamma_dtau
+  if (present(ddot_gamma_dtau_sl)) ddot_gamma_dtau_sl = ddot_gamma_dtau
-  if(present(tau_sl))             tau_sl             = tau
+  if (present(tau_sl))             tau_sl             = tau
 
 end subroutine kinetics_sl
 
@@ -962,14 +977,14 @@ pure subroutine kinetics_tw(Mp,T,dot_gamma_sl,ph,en,&
           Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,en)+stt%rho_dip(s2,en))+&
                  abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,en)+stt%rho_dip(s1,en)))/&
                   (prm%L_tw*prm%b_sl(i))*&
-                  (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tw(i,en)-tau(i))))
+                  (1.0_pReal-exp(-prm%V_cs/(K_B*T)*(dst%tau_r_tw(i,en)-tau(i))))
         else
           Ndot0=0.0_pReal
         end if
       else isFCC
         Ndot0=prm%dot_N_0_tw(i)
-      endif isFCC
+      end if isFCC
-    enddo
+    end do
 
     significantStress: where(tau > tol_math_check)
       StressRatio_r   = (dst%tau_hat_tw(:,en)/tau)**prm%r
@@ -982,7 +997,7 @@ pure subroutine kinetics_tw(Mp,T,dot_gamma_sl,ph,en,&
 
   end associate
 
-  if(present(ddot_gamma_dtau_tw)) ddot_gamma_dtau_tw = ddot_gamma_dtau
+  if (present(ddot_gamma_dtau_tw)) ddot_gamma_dtau_tw = ddot_gamma_dtau
 
 end subroutine kinetics_tw
 
@@ -1031,14 +1046,14 @@ pure subroutine kinetics_tr(Mp,T,dot_gamma_sl,ph,en,&
           Ndot0=(abs(dot_gamma_sl(s1))*(stt%rho_mob(s2,en)+stt%rho_dip(s2,en))+&
                  abs(dot_gamma_sl(s2))*(stt%rho_mob(s1,en)+stt%rho_dip(s1,en)))/&
                   (prm%L_tr*prm%b_sl(i))*&
-                  (1.0_pReal-exp(-prm%V_cs/(kB*T)*(dst%tau_r_tr(i,en)-tau(i))))
+                  (1.0_pReal-exp(-prm%V_cs/(K_B*T)*(dst%tau_r_tr(i,en)-tau(i))))
         else
           Ndot0=0.0_pReal
         end if
       else isFCC
         Ndot0=prm%dot_N_0_tr(i)
-      endif isFCC
+      end if isFCC
-    enddo
+    end do
 
     significantStress: where(tau > tol_math_check)
       StressRatio_s   = (dst%tau_hat_tr(:,en)/tau)**prm%s
@@ -1051,7 +1066,7 @@ pure subroutine kinetics_tr(Mp,T,dot_gamma_sl,ph,en,&
 
   end associate
 
-  if(present(ddot_gamma_dtau_tr)) ddot_gamma_dtau_tr = ddot_gamma_dtau
+  if (present(ddot_gamma_dtau_tr)) ddot_gamma_dtau_tr = ddot_gamma_dtau
 
 end subroutine kinetics_tr
 

src/phase_mechanical_plastic_isotropic.f90

@@ -68,11 +68,11 @@ module function plastic_isotropic_init() result(myPlasticity)
   myPlasticity = plastic_active('isotropic')
   if(count(myPlasticity) == 0) return
 
-  print'(/,a)', ' <<<+-  phase:mechanical:plastic:isotropic init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:plastic:isotropic init  -+>>>'
-  print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
+  print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
 
-  print*, 'T. Maiti and P. Eisenlohr, Scripta Materialia 145:37–40, 2018'
+  print'(/,a)', 'T. Maiti and P. Eisenlohr, Scripta Materialia 145:37–40, 2018'
-  print*, 'https://doi.org/10.1016/j.scriptamat.2017.09.047'
+  print'(/,a)', 'https://doi.org/10.1016/j.scriptamat.2017.09.047'
 
   phases => config_material%get('phase')
   allocate(param(phases%length))
@@ -140,7 +140,7 @@ module function plastic_isotropic_init() result(myPlasticity)
 !  exit if any parameter is out of range
     if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(isotropic)')
 
-  enddo
+  end do
 
 end function plastic_isotropic_init
 
@@ -232,7 +232,7 @@ module subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dMi,Mi,ph,en)
     else
       Li      = 0.0_pReal
       dLi_dMi = 0.0_pReal
-    endif
+    end if
 
   end associate
 
@@ -262,7 +262,7 @@ module subroutine isotropic_dotState(Mp,ph,en)
     norm_Mp = sqrt(math_tensordot(Mp,Mp))
   else
     norm_Mp = sqrt(math_tensordot(math_deviatoric33(Mp),math_deviatoric33(Mp)))
-  endif
+  end if
 
   dot_gamma = prm%dot_gamma_0 * (sqrt(1.5_pReal) * norm_Mp /(prm%M*stt%xi(en))) **prm%n
 
@@ -273,13 +273,13 @@ module subroutine isotropic_dotState(Mp,ph,en)
       xi_inf_star = prm%xi_inf &
                   + asinh( (dot_gamma / prm%c_1)**(1.0_pReal / prm%c_2))**(1.0_pReal / prm%c_3) &
                   / prm%c_4 * (dot_gamma / prm%dot_gamma_0)**(1.0_pReal / prm%n)
-    endif
+    end if
     dot%xi(en) = dot_gamma &
                * ( prm%h_0 + prm%h_ln * log(dot_gamma) ) &
                * sign(abs(1.0_pReal - stt%xi(en)/xi_inf_star)**prm%a *prm%h, 1.0_pReal-stt%xi(en)/xi_inf_star)
   else
     dot%xi(en) = 0.0_pReal
-  endif
+  end if
 
   end associate
 
@@ -303,7 +303,7 @@ module subroutine plastic_isotropic_results(ph,group)
         call results_writeDataset(stt%xi,group,trim(prm%output(o)), &
                                     'resistance against plastic flow','Pa')
     end select
-  enddo outputsLoop
+  end do outputsLoop
   end associate
 
 end subroutine plastic_isotropic_results

src/phase_mechanical_plastic_kinehardening.f90

@@ -83,8 +83,8 @@ module function plastic_kinehardening_init() result(myPlasticity)
   myPlasticity = plastic_active('kinehardening')
   if(count(myPlasticity) == 0) return
 
-  print'(/,a)', ' <<<+-  phase:mechanical:plastic:kinehardening init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:plastic:kinehardening init  -+>>>'
-  print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
+  print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
 
 
   phases => config_material%get('phase')
@@ -95,7 +95,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
 
 
   do ph = 1, phases%length
-    if(.not. myPlasticity(ph)) cycle
+    if (.not. myPlasticity(ph)) cycle
 
     associate(prm => param(ph), dot => dotState(ph), dlt => deltaState(ph), stt => state(ph))
 
@@ -125,7 +125,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
       else
         prm%P_nS_pos = prm%P
         prm%P_nS_neg = prm%P
-      endif
+      end if
       prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dFloat('h_sl-sl'), &
                                                    phase_lattice(ph))
 
@@ -161,7 +161,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
       xi_0 = emptyRealArray
       allocate(prm%xi_inf_f,prm%xi_inf_b,prm%h_0_f,prm%h_inf_f,prm%h_0_b,prm%h_inf_b,source=emptyRealArray)
       allocate(prm%h_sl_sl(0,0))
-    endif slipActive
+    end if slipActive
 
 !--------------------------------------------------------------------------------------------------
 ! allocate state arrays
@@ -217,7 +217,7 @@ module function plastic_kinehardening_init() result(myPlasticity)
 !  exit if any parameter is out of range
     if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(kinehardening)')
 
-  enddo
+  end do
 
 
 end function plastic_kinehardening_init
@@ -258,7 +258,7 @@ pure module subroutine kinehardening_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
       dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
                        + ddot_gamma_dtau_pos(i) * prm%P(k,l,i) * prm%P_nS_pos(m,n,i) &
                        + ddot_gamma_dtau_neg(i) * prm%P(k,l,i) * prm%P_nS_neg(m,n,i)
-  enddo
+  end do
 
   end associate
 
@@ -382,7 +382,7 @@ module subroutine plastic_kinehardening_results(ph,group)
                                     'plastic shear','1',prm%systems_sl)
       end select
 
-    enddo
+    end do
 
   end associate
 
@@ -424,7 +424,7 @@ pure subroutine kinetics(Mp,ph,en, &
       tau_pos(i) =       math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i)) - stt%chi(i,en)
       tau_neg(i) = merge(math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,i)) - stt%chi(i,en), &
                          0.0_pReal, prm%nonSchmidActive)
-    enddo
+    end do
 
     where(dNeq0(tau_pos))
       dot_gamma_pos = prm%dot_gamma_0 * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) &           ! 1/2 if non-Schmid active
@@ -446,14 +446,14 @@ pure subroutine kinetics(Mp,ph,en, &
       else where
         ddot_gamma_dtau_pos = 0.0_pReal
       end where
-    endif
+    end if
     if (present(ddot_gamma_dtau_neg)) then
       where(dNeq0(dot_gamma_neg))
         ddot_gamma_dtau_neg = dot_gamma_neg*prm%n/tau_neg
       else where
         ddot_gamma_dtau_neg = 0.0_pReal
       end where
-    endif
+    end if
 
   end associate
 

src/phase_mechanical_plastic_none.f90

@@ -22,16 +22,16 @@ module function plastic_none_init() result(myPlasticity)
 
 
   myPlasticity = plastic_active('none')
-  if(count(myPlasticity) == 0) return
+  if (count(myPlasticity) == 0) return
 
-  print'(/,a)', ' <<<+-  phase:mechanical:plastic:none init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:plastic:none init  -+>>>'
-  print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
+  print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
 
   phases => config_material%get('phase')
   do ph = 1, phases%length
-    if(.not. myPlasticity(ph)) cycle
+    if (.not. myPlasticity(ph)) cycle
     call phase_allocateState(plasticState(ph),count(material_phaseID == ph),0,0,0)
-  enddo
+  end do
 
 end function plastic_none_init
 

src/phase_mechanical_plastic_nonlocal.f90

@@ -19,9 +19,6 @@ submodule(phase:plastic) nonlocal
 
   type(tGeometry), dimension(:), allocatable :: geom
 
-  real(pReal), parameter :: &
-    kB = 1.38e-23_pReal                                                                             !< Boltzmann constant in J/Kelvin
-
   ! storage order of dislocation types
   integer, dimension(*), parameter :: &
     sgl = [1,2,3,4,5,6,7,8]                                                                         !< signed (single)
@@ -197,19 +194,19 @@ module function plastic_nonlocal_init() result(myPlasticity)
 
   myPlasticity = plastic_active('nonlocal')
   Ninstances = count(myPlasticity)
-  if(Ninstances == 0) then
+  if (Ninstances == 0) then
     call geometry_plastic_nonlocal_disable
     return
-  endif
+  end if
 
-  print'(/,a)', ' <<<+-  phase:mechanical:plastic:nonlocal init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:plastic:nonlocal init  -+>>>'
-  print'(a,i0)', ' # phases: ',Ninstances; flush(IO_STDOUT)
+  print'(/,a,i0)', ' # phases: ',Ninstances; flush(IO_STDOUT)
 
-  print*, 'C. Reuber et al., Acta Materialia 71:333–348, 2014'
+  print'(/,1x,a)', 'C. Reuber et al., Acta Materialia 71:333–348, 2014'
-  print*, 'https://doi.org/10.1016/j.actamat.2014.03.012'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.1016/j.actamat.2014.03.012'//IO_EOL
 
-  print*, 'C. Kords, Dissertation RWTH Aachen, 2014'
+  print'(/,1x,a)', 'C. Kords, Dissertation RWTH Aachen, 2014'
-  print*, 'http://publications.rwth-aachen.de/record/229993'
+  print'(  1x,a)', 'http://publications.rwth-aachen.de/record/229993'
 
 
   phases => config_material%get('phase')
@@ -224,7 +221,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
   allocate(dependentState(phases%length))
 
   do ph = 1, phases%length
-    if(.not. myPlasticity(ph)) cycle
+    if (.not. myPlasticity(ph)) cycle
 
     associate(prm => param(ph),  dot => dotState(ph),   stt => state(ph), &
               st0 => state0(ph), del => deltaState(ph), dst => dependentState(ph))
@@ -242,9 +239,6 @@ module function plastic_nonlocal_init() result(myPlasticity)
 
     prm%atol_rho = pl%get_asFloat('atol_rho',defaultVal=1.0_pReal)
 
-    prm%mu = elastic_mu(ph)
-    prm%nu = elastic_nu(ph)
-
     ini%N_sl     = pl%get_as1dInt('N_sl',defaultVal=emptyIntArray)
     prm%sum_N_sl = sum(abs(ini%N_sl))
     slipActive: if (prm%sum_N_sl > 0) then
@@ -259,7 +253,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
       else
         prm%P_nS_pos = prm%P_sl
         prm%P_nS_neg = prm%P_sl
-      endif
+      end if
 
       prm%h_sl_sl = lattice_interaction_SlipBySlip(ini%N_sl,pl%get_as1dFloat('h_sl-sl'), &
                                                    phase_lattice(ph))
@@ -280,8 +274,8 @@ module function plastic_nonlocal_init() result(myPlasticity)
            if (all(dEq0 (math_cross(prm%slip_direction(1:3,s1),prm%slip_direction(1:3,s2)))) .and. &
                any(dNeq0(math_cross(prm%slip_normal   (1:3,s1),prm%slip_normal   (1:3,s2))))) &
              prm%colinearSystem(s1) = s2
-        enddo
+        end do
-      enddo
+      end do
 
       ini%rho_u_ed_pos_0  = pl%get_as1dFloat('rho_u_ed_pos_0',   requiredSize=size(ini%N_sl))
       ini%rho_u_ed_neg_0  = pl%get_as1dFloat('rho_u_ed_neg_0',   requiredSize=size(ini%N_sl))
@@ -391,7 +385,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
       if (prm%f_ed_mult    < 0.0_pReal .or. prm%f_ed_mult    > 1.0_pReal) &
                                                   extmsg = trim(extmsg)//' f_ed_mult'
 
-    endif slipActive
+    end if slipActive
 
 !--------------------------------------------------------------------------------------------------
 ! allocate state arrays
@@ -506,7 +500,7 @@ module function plastic_nonlocal_init() result(myPlasticity)
 !  exit if any parameter is out of range
     if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(nonlocal)')
 
-  enddo
+  end do
 
   allocate(compatibility(2,maxval(param%sum_N_sl),maxval(param%sum_N_sl),nIPneighbors,&
                          discretization_nIPs,discretization_Nelems), source=0.0_pReal)
@@ -527,24 +521,24 @@ module function plastic_nonlocal_init() result(myPlasticity)
       do s = 1,param(ph)%sum_N_sl
         l = l + 1
         iRhoU(s,t,ph) = l
-      enddo
+      end do
-    enddo
+    end do
     l = l + (4+2+1+1)*param(ph)%sum_N_sl ! immobile(4), dipole(2), shear, forest
     do t = 1,4
       do s = 1,param(ph)%sum_N_sl
         l = l + 1
         iV(s,t,ph) = l
-      enddo
+      end do
-    enddo
+    end do
     do t = 1,2
       do s = 1,param(ph)%sum_N_sl
         l = l + 1
         iD(s,t,ph) = l
-      enddo
+      end do
-    enddo
+    end do
     if (iD(param(ph)%sum_N_sl,2,ph) /= plasticState(ph)%sizeState) &
       error stop 'state indices not properly set (nonlocal)'
-  enddo
+  end do
 
 end function plastic_nonlocal_init
 
@@ -570,7 +564,9 @@ module subroutine nonlocal_dependentState(ph, en, ip, el)
     n
   real(pReal) :: &
     FVsize, &
-    nRealNeighbors                                                                                  ! number of really existing neighbors
+    nRealNeighbors, &                                                                               ! number of really existing neighbors
+    mu, &
+    nu
   integer, dimension(2) :: &
     neighbors
   real(pReal), dimension(2) :: &
@@ -609,6 +605,8 @@ module subroutine nonlocal_dependentState(ph, en, ip, el)
 
   associate(prm => param(ph),dst => dependentState(ph), stt => state(ph))
 
+  mu = elastic_mu(ph,en)
+  nu = elastic_nu(ph,en)
   rho = getRho(ph,en)
 
   stt%rho_forest(:,en) = matmul(prm%forestProjection_Edge, sum(abs(rho(:,edg)),2)) &
@@ -625,9 +623,9 @@ module subroutine nonlocal_dependentState(ph, en, ip, el)
                                    / log(0.35_pReal * prm%b_sl * 1e6_pReal))** 2.0_pReal,2,prm%sum_N_sl)
   else
     myInteractionMatrix = prm%h_sl_sl
-  endif
+  end if
 
-  dst%tau_pass(:,en) = prm%mu * prm%b_sl &
+  dst%tau_pass(:,en) = mu * prm%b_sl &
                      * sqrt(matmul(myInteractionMatrix,sum(abs(rho),2)))
 
 !*** calculate the dislocation stress of the neighboring excess dislocation densities
@@ -680,14 +678,14 @@ module subroutine nonlocal_dependentState(ph, en, ip, el)
           connection_latticeConf(1:3,n) = 0.0_pReal
           rho_edg_delta_neighbor(:,n) = rho_edg_delta
           rho_scr_delta_neighbor(:,n) = rho_scr_delta
-        endif
+        end if
       else
         ! free surface -> use central values instead
         connection_latticeConf(1:3,n) = 0.0_pReal
         rho_edg_delta_neighbor(:,n) = rho_edg_delta
         rho_scr_delta_neighbor(:,n) = rho_scr_delta
-      endif
+      end if
-    enddo
+    end do
 
     neighbor_rhoExcess(1,:,:) = rho_edg_delta_neighbor
     neighbor_rhoExcess(2,:,:) = rho_scr_delta_neighbor
@@ -709,12 +707,12 @@ module subroutine nonlocal_dependentState(ph, en, ip, el)
                                - connection_latticeConf(1:3,neighbors(2))
           rhoExcessDifferences(dir) = neighbor_rhoExcess(c,s,neighbors(1)) &
                                     - neighbor_rhoExcess(c,s,neighbors(2))
-        enddo
+        end do
         invConnections = math_inv33(connections)
         if (all(dEq0(invConnections))) call IO_error(-1,ext_msg='back stress calculation: inversion error')
 
         rhoExcessGradient(c) = math_inner(m(1:3,s,c), matmul(invConnections,rhoExcessDifferences))
-      enddo
+      end do
 
         ! ... plus gradient from deads ...
       rhoExcessGradient(1) = rhoExcessGradient(1) + sum(rho(s,imm_edg)) / FVsize
@@ -728,11 +726,11 @@ module subroutine nonlocal_dependentState(ph, en, ip, el)
       where(rhoTotal > 0.0_pReal) rhoExcessGradient_over_rho = rhoExcessGradient / rhoTotal
 
         ! ... gives the local stress correction when multiplied with a factor
-      dst%tau_back(s,en) = - prm%mu * prm%b_sl(s) / (2.0_pReal * PI) &
+      dst%tau_back(s,en) = - mu * prm%b_sl(s) / (2.0_pReal * PI) &
-                         * (  rhoExcessGradient_over_rho(1) / (1.0_pReal - prm%nu) &
+                         * (  rhoExcessGradient_over_rho(1) / (1.0_pReal - nu) &
                             + rhoExcessGradient_over_rho(2))
-    enddo
+    end do
-  endif
+  end if
 
  end associate
 
@@ -790,8 +788,8 @@ module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, &
     else
       tauNS(s,3) = math_tensordot(Mp, +prm%P_nS_neg(1:3,1:3,s))
       tauNS(s,4) = math_tensordot(Mp, -prm%P_nS_pos(1:3,1:3,s))
-    endif
+    end if
-  enddo
+  end do
   tauNS = tauNS + spread(dst%tau_back(:,en),2,4)
   tau   = tau   + dst%tau_back(:,en)
 
@@ -807,12 +805,12 @@ module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, &
     do t = 3,4
       call kinetics(v(:,t), dv_dtau(:,t), dv_dtauNS(:,t), &
                     tau, tauNS(:,t), dst%tau_pass(:,en),2,Temperature, ph)
-    enddo
+    end do
   else
     v(:,3:4)         = spread(v(:,1),2,2)
     dv_dtau(:,3:4)   = spread(dv_dtau(:,1),2,2)
     dv_dtauNS(:,3:4) = spread(dv_dtauNS(:,1),2,2)
-  endif
+  end if
 
   stt%v(:,en) = pack(v,.true.)
 
@@ -833,7 +831,7 @@ module subroutine nonlocal_LpAndItsTangent(Lp,dLp_dMp, &
           + prm%P_sl(i,j,s) &
           * (+ prm%P_nS_pos(k,l,s) * rhoSgl(s,3) * dv_dtauNS(s,3) &
              - prm%P_nS_neg(k,l,s) * rhoSgl(s,4) * dv_dtauNS(s,4))  * prm%b_sl(s)
-  enddo
+  end do
 
   end associate
 
@@ -855,6 +853,9 @@ module subroutine plastic_nonlocal_deltaState(Mp,ph,en)
     c, &                                                                                            ! character of dislocation
     t, &                                                                                            ! type of dislocation
     s                                                                                               ! index of my current slip system
+  real(pReal) :: &
+    mu, &
+    nu
   real(pReal), dimension(param(ph)%sum_N_sl,10) :: &
     deltaRhoRemobilization, &                                                                       ! density increment by remobilization
     deltaRhoDipole2SingleStress                                                                     ! density increment by dipole dissociation (by stress change)
@@ -869,9 +870,12 @@ module subroutine plastic_nonlocal_deltaState(Mp,ph,en)
     dUpper, &                                                                                       ! current maximum stable dipole distance for edges and screws
     dUpperOld, &                                                                                    ! old maximum stable dipole distance for edges and screws
     deltaDUpper                                                                                     ! change in maximum stable dipole distance for edges and screws
-
+   
   associate(prm => param(ph),dst => dependentState(ph),del => deltaState(ph))
 
+  mu = elastic_mu(ph,en)
+  nu = elastic_nu(ph,en)
+
   !*** shortcut to state variables
   forall (s = 1:prm%sum_N_sl, t = 1:4) v(s,t) = plasticState(ph)%state(iV(s,t,ph),en)
   forall (s = 1:prm%sum_N_sl, c = 1:2) dUpperOld(s,c) = plasticState(ph)%state(iD(s,c,ph),en)
@@ -899,10 +903,10 @@ module subroutine plastic_nonlocal_deltaState(Mp,ph,en)
   do s = 1,prm%sum_N_sl
     tau(s) = math_tensordot(Mp, prm%P_sl(1:3,1:3,s)) +dst%tau_back(s,en)
     if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal
-  enddo
+  end do
 
-  dUpper(:,1) = prm%mu * prm%b_sl/(8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau))
+  dUpper(:,1) = mu * prm%b_sl/(8.0_pReal * PI * (1.0_pReal - nu) * abs(tau))
-  dUpper(:,2) = prm%mu * prm%b_sl/(4.0_pReal * PI * abs(tau))
+  dUpper(:,2) = mu * prm%b_sl/(4.0_pReal * PI * abs(tau))
 
   where(dNeq0(sqrt(sum(abs(rho(:,edg)),2)))) &
     dUpper(:,1) = min(1.0_pReal/sqrt(sum(abs(rho(:,edg)),2)),dUpper(:,1))
@@ -975,15 +979,20 @@ module subroutine nonlocal_dotState(Mp, Temperature,timestep, &
     dLower, &                                                                                       !< minimum stable dipole distance for edges and screws
     dUpper                                                                                          !< current maximum stable dipole distance for edges and screws
   real(pReal) :: &
-    D_SD
+    D_SD, &
+    mu, &
+    nu
 
   if (timestep <= 0.0_pReal) then
     plasticState(ph)%dotState = 0.0_pReal
     return
-  endif
+  end if
 
   associate(prm => param(ph), dst => dependentState(ph), dot => dotState(ph), stt => state(ph))
 
+  mu = elastic_mu(ph,en)
+  nu = elastic_nu(ph,en)
+
   tau = 0.0_pReal
   dot_gamma = 0.0_pReal
 
@@ -1002,11 +1011,11 @@ module subroutine nonlocal_dotState(Mp, Temperature,timestep, &
   do s = 1,prm%sum_N_sl
     tau(s) = math_tensordot(Mp, prm%P_sl(1:3,1:3,s)) + dst%tau_back(s,en)
     if (abs(tau(s)) < 1.0e-15_pReal) tau(s) = 1.0e-15_pReal
-  enddo
+  end do
 
   dLower = prm%minDipoleHeight
-  dUpper(:,1) = prm%mu * prm%b_sl/(8.0_pReal * PI * (1.0_pReal - prm%nu) * abs(tau))
+  dUpper(:,1) = mu * prm%b_sl/(8.0_pReal * PI * (1.0_pReal - nu) * abs(tau))
-  dUpper(:,2) = prm%mu * prm%b_sl/(4.0_pReal * PI * abs(tau))
+  dUpper(:,2) = mu * prm%b_sl/(4.0_pReal * PI * abs(tau))
 
   where(dNeq0(sqrt(sum(abs(rho(:,edg)),2)))) &
     dUpper(:,1) = min(1.0_pReal/sqrt(sum(abs(rho(:,edg)),2)),dUpper(:,1))
@@ -1032,7 +1041,7 @@ module subroutine nonlocal_dotState(Mp, Temperature,timestep, &
     rhoDotMultiplication(:,1:4) = spread( &
           (sum(abs(dot_gamma(:,1:2)),2) * prm%f_ed_mult + sum(abs(dot_gamma(:,3:4)),2)) &
         * sqrt(stt%rho_forest(:,en)) / prm%i_sl / prm%b_sl, 2, 4)                                   ! eq. 3.26
-  endif isBCC
+  end if isBCC
 
   forall (s = 1:prm%sum_N_sl, t = 1:4) v0(s,t) = plasticState(ph)%state0(iV(s,t,ph),en)
 
@@ -1062,7 +1071,7 @@ module subroutine nonlocal_dotState(Mp, Temperature,timestep, &
                                     + abs(rhoDotSingle2DipoleGlide(:,2*c+4)) &
                                     - rhoDotSingle2DipoleGlide(:,2*c-1) &
                                     - rhoDotSingle2DipoleGlide(:,2*c)
-  enddo
+  end do
 
 
   ! athermal annihilation
@@ -1082,9 +1091,9 @@ module subroutine nonlocal_dotState(Mp, Temperature,timestep, &
 
   ! thermally activated annihilation of edge dipoles by climb
   rhoDotThermalAnnihilation = 0.0_pReal
-  D_SD = prm%D_0 * exp(-prm%Q_cl / (kB * Temperature))                                              ! eq. 3.53
+  D_SD = prm%D_0 * exp(-prm%Q_cl / (K_B * Temperature))                                              ! eq. 3.53
-  v_climb = D_SD * prm%mu * prm%V_at &
+  v_climb = D_SD * mu * prm%V_at &
-          / (PI * (1.0_pReal-prm%nu) * (dUpper(:,1) + dLower(:,1)) * kB * Temperature)              ! eq. 3.54
+          / (PI * (1.0_pReal-nu) * (dUpper(:,1) + dLower(:,1)) * K_B * Temperature)              ! eq. 3.54
   forall (s = 1:prm%sum_N_sl, dUpper(s,1) > dLower(s,1)) &
     rhoDotThermalAnnihilation(s,9) = max(- 4.0_pReal * rhoDip(s,1) * v_climb(s) / (dUpper(s,1) - dLower(s,1)), &
                                          - rhoDip(s,1) / timestep - rhoDotAthermalAnnihilation(s,9) &
@@ -1103,13 +1112,13 @@ module subroutine nonlocal_dotState(Mp, Temperature,timestep, &
     if (debugConstitutive%extensive) then
       print'(a,i5,a,i2)', '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip
       print'(a)', '<< CONST >> enforcing cutback !!!'
-    endif
+    end if
 #endif
     plasticState(ph)%dotState = IEEE_value(1.0_pReal,IEEE_quiet_NaN)
   else
     dot%rho(:,en) = pack(rhoDot,.true.)
     dot%gamma(:,en) = sum(dot_gamma,2)
-  endif
+  end if
 
   end associate
 
@@ -1217,11 +1226,11 @@ function rhoDotFlux(timestep,ph,en,ip,el)
                              > IPvolume(ip,el) / maxval(IParea(:,ip,el))), &
         ' at a timestep of ',timestep
       print*, '<< CONST >> enforcing cutback !!!'
-    endif
+    end if
 #endif
       rhoDotFlux = IEEE_value(1.0_pReal,IEEE_quiet_NaN)                                             ! enforce cutback
       return
-    endif
+    end if
 
 
     !*** be aware of the definition of slip_transverse = slip_direction x slip_normal !!!
@@ -1255,7 +1264,7 @@ function rhoDotFlux(timestep,ph,en,ip,el)
         Favg = 0.5_pReal * (my_F + neighbor_F)
       else                                                                                          ! if no neighbor, take my value as average
         Favg = my_F
-      endif
+      end if
 
       neighbor_v0 = 0.0_pReal        ! needed for check of sign change in flux density below
 
@@ -1300,10 +1309,10 @@ function rhoDotFlux(timestep,ph,en,ip,el)
                 rhoDotFlux(:,topp) = rhoDotFlux(:,topp) &
                                    + lineLength/IPvolume(ip,el)*compatibility(c,:,s,n,ip,el)**2.0_pReal ! transferring to opposite signed mobile dislocation type
 
-            endif
+            end if
-          enddo
+          end do
-        enddo
+        end do
-      endif; endif
+      end if; end if
 
 
       !* FLUX FROM ME TO MY NEIGHBOR
@@ -1330,20 +1339,20 @@ function rhoDotFlux(timestep,ph,en,ip,el)
                 transmissivity = sum(compatibility(c,:,s,n,ip,el)**2.0_pReal)                       ! overall transmissivity from this slip system to my neighbor
               else                                                                                  ! sign change in flux density means sign change in stress which does not allow for dislocations to arive at the neighbor
                 transmissivity = 0.0_pReal
-              endif
+              end if
               lineLength = my_rhoSgl0(s,t) * v0(s,t) &
                          * math_inner(m(1:3,s,t), normal_me2neighbor) * area                        ! positive line length of mobiles that wants to leave through this interface
               rhoDotFlux(s,t) = rhoDotFlux(s,t) - lineLength / IPvolume(ip,el)                      ! subtract dislocation flux from current type
               rhoDotFlux(s,t+4) = rhoDotFlux(s,t+4) &
                                 + lineLength / IPvolume(ip,el) * (1.0_pReal - transmissivity) &
                                 * sign(1.0_pReal, v0(s,t))                                          ! dislocation flux that is not able to leave through interface (because of low transmissivity) will remain as immobile single density at the material point
-            endif
+            end if
-          enddo
+          end do
-        enddo
+        end do
-      endif; endif
+      end if; end if
 
-    enddo neighbors
+    end do neighbors
-  endif
+  end if
 
   end associate
 
@@ -1433,7 +1442,7 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,i,e)
                                                        mis%rotate(prm%slip_normal(1:3,s2)))) &
                                       * abs(math_inner(prm%slip_direction(1:3,s1), &
                                                        mis%rotate(prm%slip_direction(1:3,s2))))
-        enddo neighborSlipSystems
+        end do neighborSlipSystems
 
         my_compatibilitySum = 0.0_pReal
         belowThreshold = .true.
@@ -1446,15 +1455,15 @@ module subroutine plastic_nonlocal_updateCompatibility(orientation,ph,i,e)
               my_compatibility(:,:,s1,n) = sign((1.0_pReal - my_compatibilitySum)/nThresholdValues,&
                                                  my_compatibility(:,:,s1,n))
           my_compatibilitySum = my_compatibilitySum + nThresholdValues * thresholdValue
-        enddo
+        end do
 
         where(belowThreshold) my_compatibility(1,:,s1,n) = 0.0_pReal
         where(belowThreshold) my_compatibility(2,:,s1,n) = 0.0_pReal
 
-      enddo mySlipSystems
+      end do mySlipSystems
-    endif
+    end if
 
-  enddo neighbors
+  end do neighbors
 
   compatibility(:,:,:,:,i,e) = my_compatibility
 
@@ -1532,7 +1541,7 @@ module subroutine plastic_nonlocal_results(ph,group)
                                     'passing stress for slip','Pa', prm%systems_sl)
       end select
 
-    enddo
+    end do
 
   end associate
 
@@ -1581,7 +1590,7 @@ subroutine stateInit(ini,phase,Nentries)
         s = nint(rnd(2)*real(sum(ini%N_sl),pReal)*4.0_pReal + 0.5_pReal)
         meanDensity = meanDensity + densityBinning * geom(phase)%V_0(e) / totalVolume
         stt%rhoSglMobile(s,e) = densityBinning
-      enddo
+      end do
     else                                ! homogeneous distribution with noise
       do e = 1, Nentries
         do f = 1,size(ini%N_sl,1)
@@ -1594,12 +1603,12 @@ subroutine stateInit(ini,phase,Nentries)
             stt%rho_sgl_mob_edg_neg(s,e) = ini%rho_u_ed_neg_0(f) + noise(1)
             stt%rho_sgl_mob_scr_pos(s,e) = ini%rho_u_sc_pos_0(f) + noise(2)
             stt%rho_sgl_mob_scr_neg(s,e) = ini%rho_u_sc_neg_0(f) + noise(2)
-          enddo
+          end do
           stt%rho_dip_edg(from:upto,e)   = ini%rho_d_ed_0(f)
           stt%rho_dip_scr(from:upto,e)   = ini%rho_d_sc_0(f)
-        enddo
+        end do
-      enddo
+      end do
-    endif
+    end if
 
   end associate
 
@@ -1659,9 +1668,9 @@ pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, T,
       activationEnergy_P = criticalStress_P * activationVolume_P
       tauRel_P = min(1.0_pReal, tauEff / criticalStress_P)
       tPeierls = 1.0_pReal / prm%nu_a &
-               * exp(activationEnergy_P / (kB * T) &
+               * exp(activationEnergy_P / (K_B * T) &
                      * (1.0_pReal - tauRel_P**prm%p)**prm%q)
-      dtPeierls_dtau = merge(tPeierls * prm%p * prm%q * activationVolume_P / (kB * T) &
+      dtPeierls_dtau = merge(tPeierls * prm%p * prm%q * activationVolume_P / (K_B * T) &
                              * (1.0_pReal - tauRel_P**prm%p)**(prm%q-1.0_pReal) * tauRel_P**(prm%p-1.0_pReal), &
                              0.0_pReal, &
                              tauEff < criticalStress_P)
@@ -1673,8 +1682,8 @@ pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, T,
       criticalStress_S = prm%Q_sol / activationVolume_S
       tauRel_S = min(1.0_pReal, tauEff / criticalStress_S)
       tSolidSolution = 1.0_pReal /  prm%nu_a &
-                     * exp(prm%Q_sol / (kB * T)* (1.0_pReal - tauRel_S**prm%p)**prm%q)
+                     * exp(prm%Q_sol / (K_B * T)* (1.0_pReal - tauRel_S**prm%p)**prm%q)
-      dtSolidSolution_dtau = merge(tSolidSolution * prm%p * prm%q * activationVolume_S / (kB * T) &
+      dtSolidSolution_dtau = merge(tSolidSolution * prm%p * prm%q * activationVolume_S / (K_B * T) &
                                    * (1.0_pReal - tauRel_S**prm%p)**(prm%q-1.0_pReal)* tauRel_S**(prm%p-1.0_pReal), &
                                    0.0_pReal, &
                                    tauEff < criticalStress_S)
@@ -1688,8 +1697,8 @@ pure subroutine kinetics(v, dv_dtau, dv_dtauNS, tau, tauNS, tauThreshold, c, T,
       dv_dtau(s)   = v(s)**2.0_pReal * (dtSolidSolution_dtau / lambda_S + prm%B / (prm%b_sl(s) * tauEff**2.0_pReal))
       dv_dtauNS(s) = v(s)**2.0_pReal * dtPeierls_dtau / lambda_P
 
-    endif
+    end if
-  enddo
+  end do
 
   end associate
 
@@ -1760,8 +1769,8 @@ subroutine storeGeometry(ph)
   do ce = 1, size(material_homogenizationEntry,1)
     do co = 1, homogenization_maxNconstituents
       if (material_phaseID(co,ce) == ph) geom(ph)%V_0(material_phaseEntry(co,ce)) = V(ce)
-    enddo
+    end do
-  enddo
+  end do
 
 end subroutine
 

src/phase_mechanical_plastic_phenopowerlaw.f90

@@ -95,8 +95,8 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
   myPlasticity = plastic_active('phenopowerlaw')
   if(count(myPlasticity) == 0) return
 
-  print'(/,a)', ' <<<+-  phase:mechanical:plastic:phenopowerlaw init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:mechanical:plastic:phenopowerlaw init  -+>>>'
-  print'(a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
+  print'(/,a,i0)', ' # phases: ',count(myPlasticity); flush(IO_STDOUT)
 
 
   phases => config_material%get('phase')
@@ -105,7 +105,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
   allocate(dotState(phases%length))
 
   do ph = 1, phases%length
-    if(.not. myPlasticity(ph)) cycle
+    if (.not. myPlasticity(ph)) cycle
 
     associate(prm => param(ph), dot => dotState(ph), stt => state(ph))
 
@@ -129,7 +129,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
       else
         prm%P_nS_pos = prm%P_sl
         prm%P_nS_neg = prm%P_sl
-      endif
+      end if
       prm%h_sl_sl = lattice_interaction_SlipBySlip(N_sl,pl%get_as1dFloat('h_sl-sl'),phase_lattice(ph))
 
       xi_0_sl             = pl%get_as1dFloat('xi_0_sl',   requiredSize=size(N_sl))
@@ -158,7 +158,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
       xi_0_sl = emptyRealArray
       allocate(prm%xi_inf_sl,prm%h_int,source=emptyRealArray)
       allocate(prm%h_sl_sl(0,0))
-    endif slipActive
+    end if slipActive
 
 !--------------------------------------------------------------------------------------------------
 ! twin related parameters
@@ -192,7 +192,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
       xi_0_tw = emptyRealArray
       allocate(prm%gamma_char,source=emptyRealArray)
       allocate(prm%h_tw_tw(0,0))
-    endif twinActive
+    end if twinActive
 
 !--------------------------------------------------------------------------------------------------
 ! slip-twin related parameters
@@ -206,7 +206,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
       allocate(prm%h_sl_tw(prm%sum_N_sl,prm%sum_N_tw))                                              ! at least one dimension is 0
       allocate(prm%h_tw_sl(prm%sum_N_tw,prm%sum_N_sl))                                              ! at least one dimension is 0
       prm%h_0_tw_sl = 0.0_pReal
-    endif slipAndTwinActive
+    end if slipAndTwinActive
 
 !--------------------------------------------------------------------------------------------------
 !  output pararameters
@@ -263,7 +263,7 @@ module function plastic_phenopowerlaw_init() result(myPlasticity)
 !  exit if any parameter is out of range
     if (extmsg /= '') call IO_error(211,ext_msg=trim(extmsg)//'(phenopowerlaw)')
 
-  enddo
+  end do
 
 end function plastic_phenopowerlaw_init
 
@@ -306,7 +306,7 @@ pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
       dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
                        + ddot_gamma_dtau_sl_pos(i) * prm%P_sl(k,l,i) * prm%P_nS_pos(m,n,i) &
                        + ddot_gamma_dtau_sl_neg(i) * prm%P_sl(k,l,i) * prm%P_nS_neg(m,n,i)
-  enddo slipSystems
+  end do slipSystems
 
   call kinetics_tw(Mp,ph,en,dot_gamma_tw,ddot_gamma_dtau_tw)
   twinSystems: do i = 1, prm%sum_N_tw
@@ -314,7 +314,7 @@ pure module subroutine phenopowerlaw_LpAndItsTangent(Lp,dLp_dMp,Mp,ph,en)
     forall (k=1:3,l=1:3,m=1:3,n=1:3) &
       dLp_dMp(k,l,m,n) = dLp_dMp(k,l,m,n) &
                        + ddot_gamma_dtau_tw(i)*prm%P_tw(k,l,i)*prm%P_tw(m,n,i)
-  enddo twinSystems
+  end do twinSystems
 
   end associate
 
@@ -397,7 +397,7 @@ module subroutine plastic_phenopowerlaw_results(ph,group)
 
       end select
 
-    enddo
+    end do
 
   end associate
 
@@ -438,7 +438,7 @@ pure subroutine kinetics_sl(Mp,ph,en, &
       tau_sl_pos(i) =       math_tensordot(Mp,prm%P_nS_pos(1:3,1:3,i))
       tau_sl_neg(i) = merge(math_tensordot(Mp,prm%P_nS_neg(1:3,1:3,i)), &
                             0.0_pReal, prm%nonSchmidActive)
-    enddo
+    end do
 
     where(dNeq0(tau_sl_pos))
       dot_gamma_sl_pos = prm%dot_gamma_0_sl * merge(0.5_pReal,1.0_pReal, prm%nonSchmidActive) &     ! 1/2 if non-Schmid active
@@ -460,14 +460,14 @@ pure subroutine kinetics_sl(Mp,ph,en, &
       else where
         ddot_gamma_dtau_sl_pos = 0.0_pReal
       end where
-    endif
+    end if
     if (present(ddot_gamma_dtau_sl_neg)) then
       where(dNeq0(dot_gamma_sl_neg))
         ddot_gamma_dtau_sl_neg = dot_gamma_sl_neg*prm%n_sl/tau_sl_neg
       else where
         ddot_gamma_dtau_sl_neg = 0.0_pReal
       end where
-    endif
+    end if
 
   end associate
 
@@ -517,7 +517,7 @@ pure subroutine kinetics_tw(Mp,ph,en,&
       else where
         ddot_gamma_dtau_tw = 0.0_pReal
       end where
-    endif
+    end if
 
   end associate
 

src/phase_thermal.f90

@@ -86,7 +86,7 @@ module subroutine thermal_init(phases)
     Nmembers
 
 
-  print'(/,a)', ' <<<+-  phase:thermal init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:thermal init  -+>>>'
 
   allocate(current(phases%length))
 

src/phase_thermal_dissipation.f90

@@ -36,8 +36,8 @@ module function dissipation_init(source_length) result(mySources)
 
   mySources = thermal_active('dissipation',source_length)
   if(count(mySources) == 0) return
-  print'(/,a)', ' <<<+-  phase:thermal:dissipation init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:thermal:dissipation init  -+>>>'
-  print'(a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT)
+  print'(/,a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT)
 
 
   phases => config_material%get('phase')
@@ -45,11 +45,11 @@ module function dissipation_init(source_length) result(mySources)
 
   do ph = 1, phases%length
     phase => phases%get(ph)
-    if(count(mySources(:,ph)) == 0) cycle !ToDo: error if > 1
+    if (count(mySources(:,ph)) == 0) cycle !ToDo: error if > 1
     thermal => phase%get('thermal')
     sources => thermal%get('source')
     do so = 1, sources%length
-      if(mySources(so,ph)) then
+      if (mySources(so,ph)) then
         associate(prm  => param(ph))
           src => sources%get(so)
 
@@ -58,9 +58,9 @@ module function dissipation_init(source_length) result(mySources)
           call phase_allocateState(thermalState(ph)%p(so),Nmembers,0,0,0)
 
         end associate
-      endif
+      end if
-    enddo
+    end do
-  enddo
+  end do
 
 
 end function dissipation_init

src/phase_thermal_externalheat.f90

@@ -43,8 +43,8 @@ module function externalheat_init(source_length) result(mySources)
 
   mySources = thermal_active('externalheat',source_length)
   if(count(mySources) == 0) return
-  print'(/,a)', ' <<<+-  phase:thermal:externalheat init  -+>>>'
+  print'(/,1x,a)', '<<<+-  phase:thermal:externalheat init  -+>>>'
-  print'(a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT)
+  print'(/,a,i2)', ' # phases: ',count(mySources); flush(IO_STDOUT)
 
 
   phases => config_material%get('phase')
@@ -53,11 +53,11 @@ module function externalheat_init(source_length) result(mySources)
 
   do ph = 1, phases%length
     phase => phases%get(ph)
-    if(count(mySources(:,ph)) == 0) cycle
+    if (count(mySources(:,ph)) == 0) cycle
     thermal => phase%get('thermal')
     sources => thermal%get('source')
     do so = 1, sources%length
-      if(mySources(so,ph)) then
+      if (mySources(so,ph)) then
         source_thermal_externalheat_offset(ph) = so
         associate(prm  => param(ph))
           src => sources%get(so)
@@ -70,9 +70,9 @@ module function externalheat_init(source_length) result(mySources)
           Nmembers = count(material_phaseID == ph)
           call phase_allocateState(thermalState(ph)%p(so),Nmembers,1,1,0)
         end associate
-      endif
+      end if
-    enddo
+    end do
-  enddo
+  end do
 
 end function externalheat_init
 
@@ -125,7 +125,7 @@ module function externalheat_f_T(ph,en) result(f_T)
         f_T = prm%f_T(interval  ) * (1.0_pReal - frac_time) + &
               prm%f_T(interval+1) * frac_time                                                      ! interpolate heat rate between segment boundaries...
                                                                                                    ! ...or extrapolate if outside of bounds
-    enddo
+    end do
   end associate
 
 end function externalheat_f_T

src/prec.f90

@@ -69,15 +69,15 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine prec_init
 
-  print'(/,a)', ' <<<+-  prec init  -+>>>'
+  print'(/,1x,a)', '<<<+-  prec init  -+>>>'
 
-  print'(a,i3)',    ' Size of integer in bit: ',bit_size(0)
+  print'(/,a,i3)',    ' integer size / bit:   ',bit_size(0)
-  print'(a,i19)',   '   Maximum value:        ',huge(0)
+  print'(  a,i19)',   '   maximum value:      ',huge(0)
-  print'(/,a,i3)',  ' Size of float in bit:   ',storage_size(0.0_pReal)
+  print'(/,a,i3)',    ' float size / bit:     ',storage_size(0.0_pReal)
-  print'(a,e10.3)', '   Maximum value:        ',huge(0.0_pReal)
+  print'(  a,e10.3)', '   maximum value:      ',huge(0.0_pReal)
-  print'(a,e10.3)', '   Minimum value:        ',PREAL_MIN
+  print'(  a,e10.3)', '   minimum value:      ',PREAL_MIN
-  print'(a,e10.3)', '   Epsilon value:        ',PREAL_EPSILON
+  print'(  a,e10.3)', '   epsilon value:      ',PREAL_EPSILON
-  print'(a,i3)',    '   Decimal precision:    ',precision(0.0_pReal)
+  print'(  a,i3)',    '   decimal precision:  ',precision(0.0_pReal)
 
   call selfTest
 

src/results.f90

@@ -70,10 +70,10 @@ subroutine results_init(restart)
   character(len=:), allocatable :: date
 
 
-  print'(/,a)', ' <<<+-  results init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  results init  -+>>>'; flush(IO_STDOUT)
 
-  print*, 'M. Diehl et al., Integrating Materials and Manufacturing Innovation 6(1):83–91, 2017'
+  print'(/,1x,a)', 'M. Diehl et al., Integrating Materials and Manufacturing Innovation 6(1):83–91, 2017'
-  print*, 'https://doi.org/10.1007/s40192-017-0084-5'//IO_EOL
+  print'(  1x,a)', 'https://doi.org/10.1007/s40192-017-0084-5'
 
   if (.not. restart) then
     resultsFile = HDF5_openFile(getSolverJobName()//'.hdf5','w')
@@ -98,7 +98,7 @@ subroutine results_init(restart)
     call results_closeGroup(results_addGroup('setup'))
     call results_addAttribute('description','input data used to run the simulation','setup')
     call h5gmove_f(resultsFile,'tmp','setup/previous',hdferr)
-  endif
+  end if
 
   call results_closeJobFile
 
@@ -222,7 +222,7 @@ subroutine results_addAttribute_str(attrLabel,attrValue,path)
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path)
   else
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue)
-  endif
+  end if
 
 end subroutine results_addAttribute_str
 
@@ -241,7 +241,7 @@ subroutine results_addAttribute_int(attrLabel,attrValue,path)
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path)
   else
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue)
-  endif
+  end if
 
 end subroutine results_addAttribute_int
 
@@ -260,7 +260,7 @@ subroutine results_addAttribute_real(attrLabel,attrValue,path)
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path)
   else
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue)
-  endif
+  end if
 
 end subroutine results_addAttribute_real
 
@@ -279,7 +279,7 @@ subroutine results_addAttribute_str_array(attrLabel,attrValue,path)
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path)
   else
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue)
-  endif
+  end if
 
 end subroutine results_addAttribute_str_array
 
@@ -298,7 +298,7 @@ subroutine results_addAttribute_int_array(attrLabel,attrValue,path)
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path)
   else
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue)
-  endif
+  end if
 
 end subroutine results_addAttribute_int_array
 
@@ -317,7 +317,7 @@ subroutine results_addAttribute_real_array(attrLabel,attrValue,path)
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue, path)
   else
     call HDF5_addAttribute(resultsFile,attrLabel, attrValue)
-  endif
+  end if
 
 end subroutine results_addAttribute_real_array
 
@@ -390,7 +390,7 @@ subroutine results_writeVectorDataset_real(dataset,group,label,description,SIuni
 
   if (present(systems)) then
     if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe also implement for other results_write (not sure about scalar)
-  endif
+  end if
 
   groupHandle = results_openGroup(group)
   call HDF5_write(dataset,groupHandle,label)
@@ -422,7 +422,7 @@ subroutine results_writeTensorDataset_real(dataset,group,label,description,SIuni
     transposed_ = transposed
   else
     transposed_ = .true.
-  endif
+  end if
 
   groupHandle = results_openGroup(group)
   if(transposed_) then
@@ -430,11 +430,11 @@ subroutine results_writeTensorDataset_real(dataset,group,label,description,SIuni
     allocate(dataset_transposed,mold=dataset)
     do i=1,size(dataset_transposed,3)
       dataset_transposed(:,:,i) = transpose(dataset(:,:,i))
-    enddo
+    end do
     call HDF5_write(dataset_transposed,groupHandle,label)
   else
     call HDF5_write(dataset,groupHandle,label)
-  endif
+  end if
   call executionStamp(group//'/'//label,description,SIunit)
   call HDF5_closeGroup(groupHandle)
 
@@ -456,7 +456,7 @@ subroutine results_writeVectorDataset_int(dataset,group,label,description,SIunit
 
   if (present(systems)) then
     if (size(systems)*size(dataset,2) == 0 ) return !ToDo: maybe also implement for other results_write (not sure about scalar)
-  endif
+  end if
 
   groupHandle = results_openGroup(group)
   call HDF5_write(dataset,groupHandle,label)
@@ -542,16 +542,16 @@ subroutine results_mapping_phase(ID,entry,label)
   do co = 1, size(ID,1)
     do ce = 1, size(ID,2)
       entryOffset(ID(co,ce),worldrank) = entryOffset(ID(co,ce),worldrank) +1
-    enddo
+    end do
-  enddo
+  end do
   call MPI_Allreduce(MPI_IN_PLACE,entryOffset,size(entryOffset),MPI_INT,MPI_SUM,MPI_COMM_WORLD,ierr)! get offset at each process
   if(ierr /= 0) error stop 'MPI error'
   entryOffset(:,worldrank) = sum(entryOffset(:,0:worldrank-1),2)
   do co = 1, size(ID,1)
     do ce = 1, size(ID,2)
       entryGlobal(co,ce) = entry(co,ce) -1 + entryOffset(ID(co,ce),worldrank)
-    enddo
+    end do
-  enddo
+  end do
 #endif
 
   myShape = int([size(ID,1),writeSize(worldrank)], HSIZE_T)
@@ -694,13 +694,13 @@ subroutine results_mapping_homogenization(ID,entry,label)
   entryOffset = 0
   do ce = 1, size(ID,1)
     entryOffset(ID(ce),worldrank) = entryOffset(ID(ce),worldrank) +1
-  enddo
+  end do
   call MPI_Allreduce(MPI_IN_PLACE,entryOffset,size(entryOffset),MPI_INT,MPI_SUM,MPI_COMM_WORLD,ierr)! get offset at each process
   if(ierr /= 0) error stop 'MPI error'
   entryOffset(:,worldrank) = sum(entryOffset(:,0:worldrank-1),2)
   do ce = 1, size(ID,1)
     entryGlobal(ce) = entry(ce) -1 + entryOffset(ID(ce),worldrank)
-  enddo
+  end do
 #endif
 
   myShape = int([writeSize(worldrank)], HSIZE_T)

src/rotations.f90

@@ -75,7 +75,6 @@ module rotations
       procedure, public  :: rotVector
       procedure, public  :: rotTensor2
       procedure, public  :: rotTensor4
-      procedure, public  :: rotTensor4sym
       procedure, public  :: misorientation
       procedure, public  :: standardize
   end type rotation
@@ -103,10 +102,10 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine rotations_init
 
-  print'(/,a)', ' <<<+-  rotations init  -+>>>'; flush(IO_STDOUT)
+  print'(/,1x,a)', '<<<+-  rotations init  -+>>>'; flush(IO_STDOUT)
 
-  print*, 'D. Rowenhorst et al., Modelling and Simulation in Materials Science and Engineering 23:083501, 2015'
+  print'(/,1x,a)', 'D. Rowenhorst et al., Modelling and Simulation in Materials Science and Engineering 23:083501, 2015'
-  print*, 'https://doi.org/10.1088/0965-0393/23/8/083501'
+  print'(  1x,a)', 'https://doi.org/10.1088/0965-0393/23/8/083501'
 
   call selfTest
 
@@ -371,27 +370,6 @@ pure function rotTensor4(self,T,active) result(tRot)
 end function rotTensor4
 
 
-!---------------------------------------------------------------------------------------------------
-!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
-!> @brief rotate a symmetric rank-4 tensor stored as (6,6) passively (default) or actively
-!! ToDo: Need to check active/passive !!!
-!---------------------------------------------------------------------------------------------------
-pure function rotTensor4sym(self,T,active) result(tRot)
-
-  real(pReal),                 dimension(6,6) :: tRot
-  class(rotation), intent(in)                 :: self
-  real(pReal),     intent(in), dimension(6,6) :: T
-  logical,         intent(in), optional       :: active
-
-  if (present(active)) then
-    tRot = math_sym3333to66(rotTensor4(self,math_66toSym3333(T),active))
-  else
-    tRot = math_sym3333to66(rotTensor4(self,math_66toSym3333(T)))
-  endif
-
-end function rotTensor4sym
-
-
 !---------------------------------------------------------------------------------------------------
 !> @brief misorientation
 !---------------------------------------------------------------------------------------------------
@@ -400,6 +378,7 @@ pure elemental function misorientation(self,other)
   type(rotation)              :: misorientation
   class(rotation), intent(in) :: self, other
 
+
   misorientation%q = multiply_quaternion(other%q, conjugate_quaternion(self%q))
 
 end function misorientation