Merge branch 'development' into test_PETSc_pointer

.gitlab-ci.yml

@@ -506,7 +506,7 @@ Processing:
     - rm abq_addUserOutput.py marc_addUserOutput.py
     - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py
     - cd $DAMASKROOT/processing/post
-    - rm marc_to_vtk.py vtk2ang.py DAD*.py
+    - rm vtk2ang.py DAD*.py
     - $DAMASKROOT/PRIVATE/documenting/scriptHelpToWiki.py --debug *.py
   except:
     - master

PRIVATE

@@ -1 +1 @@
-Subproject commit aadf2d82a7e04646e3f20c3d526f27a6f90acef0
+Subproject commit 3a2f89547c264044a7bfab9d33aee78eec495a76

VERSION

@@ -1 +1 @@
-v2.0.3-252-g0e77be25
+v2.0.3-344-gb25c64d1

cmake/Compiler-Intel.cmake

@@ -32,6 +32,8 @@
   # disables warnings ...
   set (COMPILE_FLAGS "${COMPILE_FLAGS} 5268")
   #   ... the text exceeds right hand column allowed on the line (we have only comments there)
+  set (COMPILE_FLAGS "${COMPILE_FLAGS},7624")
+  #   ... about deprecated forall (has nice syntax and most likely a performance advantage)
 
   set (COMPILE_FLAGS "${COMPILE_FLAGS} -warn")
   # enables warnings ...

processing/post/DADF5_postResults.py

@@ -22,10 +22,15 @@ parser.add_argument('filenames', nargs='+',
                     help='DADF5 files')
 parser.add_argument('-d','--dir', dest='dir',default='postProc',metavar='string',
                     help='name of subdirectory to hold output')
+parser.add_argument('--mat', nargs='+',
+                    help='labels for materialpoint/homogenization',dest='mat')
+parser.add_argument('--con', nargs='+',
+                    help='labels for constituent/crystallite/constitutive',dest='con')
 
 options = parser.parse_args()
 
-options.labels = ['Fe','Fp','xi_sl']
+if options.mat is None: options.mat=[]
+if options.con is None: options.con=[]
 
 # --- loop over input files ------------------------------------------------------------------------
 
@@ -48,16 +53,13 @@ for filename in options.filenames:
     
     data = np.array([inc['inc'] for j in range(np.product(results.grid))]).reshape([np.product(results.grid),1])
     header+= 'inc'
-    
-    data = np.concatenate((data,np.array([j+1 for j in range(np.product(results.grid))]).reshape([np.product(results.grid),1])),1)
-    header+=' node'
 
     coords = coords.reshape([np.product(results.grid),3])
     data = np.concatenate((data,coords),1)
     header+=' 1_pos 2_pos 3_pos'
         
     results.active['increments'] = [inc]
-    for label in options.labels:
+    for label in options.con:
       for o in results.c_output_types:
         results.active['c_output_types'] = [o]
         for c in results.constituents:
@@ -67,12 +69,33 @@ for filename in options.filenames:
             continue
           label = x[0].split('/')[-1]
           array = results.read_dataset(x,0)
-          d = np.product(np.shape(array)[1:])
+          d = int(np.product(np.shape(array)[1:]))
           array = np.reshape(array,[np.product(results.grid),d])
           data = np.concatenate((data,array),1)
           
-          header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)])
+          if d>1:
-
+            header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)])
+          else:
+            header+=' '+label
+            
+    for label in options.mat:
+      for o in results.m_output_types:
+        results.active['m_output_types'] = [o]
+        for m in results.materialpoints:
+          results.active['materialpoints'] = [m]
+          x = results.get_dataset_location(label)
+          if len(x) == 0:
+            continue
+          label = x[0].split('/')[-1]
+          array = results.read_dataset(x,0)
+          d = int(np.product(np.shape(array)[1:]))
+          array = np.reshape(array,[np.product(results.grid),d])
+          data = np.concatenate((data,array),1)
+          
+          if d>1:
+            header+= ''.join([' {}_{}'.format(j+1,label) for j in range(d)])
+          else:
+            header+=' '+label
 
     dirname  = os.path.abspath(os.path.join(os.path.dirname(filename),options.dir))
     try:

processing/post/DADF5_vtk_cells.py

@@ -23,10 +23,15 @@ parser.add_argument('filenames', nargs='+',
                     help='DADF5 files')
 parser.add_argument('-d','--dir', dest='dir',default='postProc',metavar='string',
                     help='name of subdirectory to hold output')
+parser.add_argument('--mat', nargs='+',
+                    help='labels for materialpoint/homogenization',dest='mat')
+parser.add_argument('--con', nargs='+',
+                    help='labels for constituent/crystallite/constitutive',dest='con')
 
 options = parser.parse_args()
 
-options.labels = ['Fe','Fp','xi_sl']
+if options.mat is None: options.mat=[]
+if options.con is None: options.con=[]
 
 # --- loop over input files ------------------------------------------------------------------------
 
@@ -54,7 +59,9 @@ for filename in options.filenames:
     print('Output step {}/{}'.format(i+1,len(results.increments)))
     vtk_data = []
     results.active['increments'] = [inc]
-    for label in options.labels:
+    
+    for label in options.con:
+      
       for o in results.c_output_types:
         results.active['c_output_types'] = [o]
         if o != 'generic':

processing/post/marc_to_vtk.py

@@ -1,199 +0,0 @@
-#!/usr/bin/env python2.7
-# -*- coding: UTF-8 no BOM -*-
-
-import os,sys,re
-import argparse
-import damask
-import vtk, numpy as np
-
-scriptName = os.path.splitext(os.path.basename(__file__))[0]
-scriptID   = ' '.join([scriptName, damask.version])
-
-parser = argparse.ArgumentParser(description='Convert from Marc input file format (.dat) to VTK format (.vtu)', version = scriptID)
-parser.add_argument('filename', type=str, help='file to convert')
-parser.add_argument('-t', '--table',  type=str, help='ASCIItable file containing nodal data to subdivide and interpolate')
-
-args = parser.parse_args()
-
-with open(args.filename, 'r') as marcfile:
-  marctext = marcfile.read();
-  
-# Load table (if any)
-if args.table is not None:
-  try:
-    table = damask.ASCIItable(
-      name=args.table,
-      outname='subdivided_{}'.format(args.table),
-      buffered=True
-    )
-    
-    table.head_read()
-    table.data_readArray()
-    
-    # Python list is faster for appending
-    nodal_data = list(table.data)
-  except: args.table = None
-
-# Extract connectivity chunk from file...
-connectivity_text = re.findall(r'connectivity[\n\r]+(.*?)[\n\r]+[a-zA-Z]', marctext, flags=(re.MULTILINE | re.DOTALL))[0]
-connectivity_lines = re.split(r'[\n\r]+', connectivity_text, flags=(re.MULTILINE | re.DOTALL))
-connectivity_header = connectivity_lines[0]
-connectivity_lines = connectivity_lines[1:]
-
-# Construct element map
-elements = dict(map(lambda line: 
-  (
-    int(line[0:10]), # index
-    { 
-      'type':  int(line[10:20]), 
-      'verts': list(map(int, re.split(r' +', line[20:].strip())))
-    }
-  ), connectivity_lines))
-
-# Extract coordinate chunk from file
-coordinates_text = re.findall(r'coordinates[\n\r]+(.*?)[\n\r]+[a-zA-Z]', marctext, flags=(re.MULTILINE | re.DOTALL))[0]
-coordinates_lines = re.split(r'[\n\r]+', coordinates_text, flags=(re.MULTILINE | re.DOTALL))
-coordinates_header = coordinates_lines[0]
-coordinates_lines = coordinates_lines[1:]
-
-# marc input file does not use "e" in scientific notation, this adds it and converts
-fl_format = lambda string: float(re.sub(r'(\d)([\+\-])', r'\1e\2', string))
-# Construct coordinate map
-coordinates = dict(map(lambda line:
-  (
-    int(line[0:10]),
-    np.array([
-      fl_format(line[10:30]), 
-      fl_format(line[30:50]), 
-      fl_format(line[50:70])
-    ])
-  ), coordinates_lines))
-
-# Subdivide volumes
-grid = vtk.vtkUnstructuredGrid()
-vertex_count = len(coordinates)
-edge_to_vert = dict() # when edges are subdivided, a new vertex in the middle is produced and placed in here
-ordered_pair = lambda a, b: (a, b) if a < b else (b, a) # edges are bidirectional
-
-def subdivide_edge(vert1, vert2):
-  edge = ordered_pair(vert1, vert2)
-  
-  if edge in edge_to_vert:
-    return edge_to_vert[edge]
-  
-  # Vertex does not exist, create it
-  newvert = len(coordinates) + 1
-  coordinates[newvert] = 0.5 * (coordinates[vert1] + coordinates[vert2]) # Average
-  edge_to_vert[edge] = newvert;
-  
-  # Interpolate nodal data
-  if args.table is not None:
-    nodal_data.append(0.5 * (nodal_data[vert1 - 1] + nodal_data[vert2 - 1]))
-  return newvert;
-
-for el_id in range(1, len(elements) + 1): # Marc starts counting at 1
-  el = elements[el_id]
-  if el['type'] == 7:
-    # Hexahedron, subdivided
-    
-    # There may be a better way to iterate over these, but this is consistent
-    # with the ordering scheme provided at https://damask.mpie.de/pub/Documentation/ElementType
-    
-    subverts = np.zeros((3,3,3), dtype=int)
-    # Get corners
-    subverts[0, 0, 0] = el['verts'][0]
-    subverts[2, 0, 0] = el['verts'][1]
-    subverts[2, 2, 0] = el['verts'][2]
-    subverts[0, 2, 0] = el['verts'][3]
-    subverts[0, 0, 2] = el['verts'][4]
-    subverts[2, 0, 2] = el['verts'][5]
-    subverts[2, 2, 2] = el['verts'][6]
-    subverts[0, 2, 2] = el['verts'][7]
-    
-    # lower edges
-    subverts[1, 0, 0] = subdivide_edge(subverts[0, 0, 0], subverts[2, 0, 0])
-    subverts[2, 1, 0] = subdivide_edge(subverts[2, 0, 0], subverts[2, 2, 0])
-    subverts[1, 2, 0] = subdivide_edge(subverts[2, 2, 0], subverts[0, 2, 0])
-    subverts[0, 1, 0] = subdivide_edge(subverts[0, 2, 0], subverts[0, 0, 0])
-    
-    # middle edges
-    subverts[0, 0, 1] = subdivide_edge(subverts[0, 0, 0], subverts[0, 0, 2])
-    subverts[2, 0, 1] = subdivide_edge(subverts[2, 0, 0], subverts[2, 0, 2])
-    subverts[2, 2, 1] = subdivide_edge(subverts[2, 2, 0], subverts[2, 2, 2])
-    subverts[0, 2, 1] = subdivide_edge(subverts[0, 2, 0], subverts[0, 2, 2])
-    
-    # top edges
-    subverts[1, 0, 2] = subdivide_edge(subverts[0, 0, 2], subverts[2, 0, 2])
-    subverts[2, 1, 2] = subdivide_edge(subverts[2, 0, 2], subverts[2, 2, 2])
-    subverts[1, 2, 2] = subdivide_edge(subverts[2, 2, 2], subverts[0, 2, 2])
-    subverts[0, 1, 2] = subdivide_edge(subverts[0, 2, 2], subverts[0, 0, 2])
-    
-    # then faces...  The edge_to_vert addition is due to there being two ways
-    # to calculate a face vertex, depending on which opposite vertices are used to subdivide.
-    # This way, we avoid creating duplicate vertices.
-    subverts[1, 1, 0] = subdivide_edge(subverts[1, 0, 0], subverts[1, 2, 0])
-    edge_to_vert[ordered_pair(subverts[0, 1, 0], subverts[2, 1, 0])] = subverts[1, 1, 0]
-    
-    subverts[1, 0, 1] = subdivide_edge(subverts[1, 0, 0], subverts[1, 0, 2])
-    edge_to_vert[ordered_pair(subverts[0, 0, 1], subverts[2, 0, 1])] = subverts[1, 0, 1]
-    
-    subverts[2, 1, 1] = subdivide_edge(subverts[2, 1, 0], subverts[2, 1, 2])
-    edge_to_vert[ordered_pair(subverts[2, 0, 1], subverts[2, 2, 1])] = subverts[2, 1, 1]
-    
-    subverts[1, 2, 1] = subdivide_edge(subverts[1, 2, 0], subverts[1, 2, 2])
-    edge_to_vert[ordered_pair(subverts[0, 2, 1], subverts[2, 2, 1])] = subverts[1, 2, 1]
-    
-    subverts[0, 1, 1] = subdivide_edge(subverts[0, 1, 0], subverts[0, 1, 2])
-    edge_to_vert[ordered_pair(subverts[0, 0, 1], subverts[0, 2, 1])] = subverts[0, 1, 1]
-    
-    subverts[1, 1, 2] = subdivide_edge(subverts[1, 0, 2], subverts[1, 2, 2])
-    edge_to_vert[ordered_pair(subverts[0, 1, 2], subverts[2, 1, 2])] = subverts[1, 1, 2]
-    
-    # and finally the center.  There are three ways to calculate, but elements should
-    # not intersect, so the edge_to_vert part isn't needed here.
-    subverts[1, 1, 1] = subdivide_edge(subverts[1, 1, 0], subverts[1, 1, 2])
-    
-    
-    # Now make the hexahedron subelements
-    # order in which vtk expects vertices for a hexahedron
-    order = np.array([(0,0,0),(1,0,0),(1,1,0),(0,1,0),(0,0,1),(1,0,1),(1,1,1),(0,1,1)])
-    for z in range(2):
-      for y in range(2):
-        for x in range(2):
-          hex_ = vtk.vtkHexahedron()
-          for vert_id in range(8):
-            coord = order[vert_id] + (x, y, z)
-            # minus one, since vtk starts at zero but marc starts at one
-            hex_.GetPointIds().SetId(vert_id, subverts[coord[0], coord[1], coord[2]] - 1) 
-          grid.InsertNextCell(hex_.GetCellType(), hex_.GetPointIds())
-    
-  else:
-    damask.util.croak('Unsupported Marc element type: {} (skipping)'.format(el['type']))
-
-# Load all points
-points = vtk.vtkPoints()
-for point in range(1, len(coordinates) + 1): # marc indices start at 1
-  points.InsertNextPoint(coordinates[point].tolist())
-
-grid.SetPoints(points)
-
-# grid now contains the elements from the given marc file
-writer = vtk.vtkXMLUnstructuredGridWriter()
-writer.SetFileName(re.sub(r'\..+', ".vtu", args.filename))  # *.vtk extension does not work in paraview
-
-if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(grid)
-else:                          writer.SetInputData(grid)
-writer.Write()
-
-if args.table is not None:  
-  table.info_append([
-    scriptID + ' ' + ' '.join(sys.argv[1:]),
-  ])
-  table.head_write()
-  table.output_flush()
-  
-  table.data = np.array(nodal_data)
-  
-  table.data_writeArray()
-
-table.close()

processing/pre/geom_addPrimitive.py

@@ -43,7 +43,7 @@ parser.add_option('-e', '--exponent',  dest='exponent',
                   1 gives a sphere (|x|^(2^1) + |y|^(2^1) + |z|^(2^1) < 1), \
                   large values produce boxes, negative turns concave.')
 parser.add_option('-f', '--fill',       dest='fill',
-                  type='int', metavar = 'int',
+                  type='float', metavar = 'float',
                   help='grain index to fill primitive. "0" selects maximum microstructure index + 1 [%default]')
 parser.add_option('-q', '--quaternion', dest='quaternion',
                   type='float', nargs = 4, metavar=' '.join(['float']*4),
@@ -60,15 +60,24 @@ parser.add_option(     '--nonperiodic', dest='periodic',
 parser.add_option(     '--realspace',  dest='realspace',
                   action='store_true',
                   help = '-c and -d span [origin,origin+size] instead of [0,grid] coordinates')
+parser.add_option(     '--invert',  dest='inside',
+                  action='store_false',
+                  help = 'invert the volume filled by the primitive (inside/outside)')
+parser.add_option('--float',        dest = 'float',
+                  action = 'store_true',
+                  help = 'use float input')
 parser.set_defaults(center = (.0,.0,.0),
-                    fill = 0,
+                    fill = 0.0,
                     degrees = False,
                     exponent = (20,20,20), # box shape by default
                     periodic = True,
                     realspace = False,
+                    inside = True,
+                    float = False,
                    )
 
 (options, filenames) = parser.parse_args()
+
 if options.dimension is None:
   parser.error('no dimension specified.')   
 if options.angleaxis is not None:
@@ -78,6 +87,8 @@ elif options.quaternion is not None:
 else:
   rotation = damask.Rotation()
 
+datatype = 'f' if options.float else 'i'
+
 options.center = np.array(options.center)
 options.dimension = np.array(options.dimension)
 # undo logarithmic sense of exponent and generate ellipsoids for negative dimensions (backward compatibility)
@@ -97,13 +108,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  %s'%(' x '.join(map(str,info['grid']))),
-                     'size     x y z:  %s'%(' x '.join(map(str,info['size']))),
-                     'origin   x y z:  %s'%(' : '.join(map(str,info['origin']))),
-                     'homogenization:  %i'%info['homogenization'],
-                     'microstructures: %i'%info['microstructures'],
-              ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
@@ -115,7 +120,7 @@ for name in filenames:
 
 #--- read data ------------------------------------------------------------------------------------
 
-  microstructure = table.microstructure_read(info['grid'])                                          # read microstructure
+  microstructure = table.microstructure_read(info['grid'],datatype)                          # read microstructure
 
 # --- do work ------------------------------------------------------------------------------------
 
@@ -123,7 +128,7 @@ for name in filenames:
              'microstructures': 0,
             }
 
-  options.fill = microstructure.max()+1 if options.fill == 0 else options.fill
+  options.fill = np.nanmax(microstructure)+1 if options.fill == 0 else options.fill
   
   microstructure = microstructure.reshape(info['grid'],order='F')
   
@@ -193,19 +198,23 @@ for name in filenames:
                          grid[1] * j : grid[1] * (j+1),
                          grid[2] * k : grid[2] * (k+1)])**options.exponent[2] <= 1.0)
     
-    microstructure = np.where(inside, options.fill, microstructure)   
+    microstructure = np.where(inside,
+                              options.fill   if options.inside else microstructure,
+                              microstructure if options.inside else options.fill)   
 
   else: # nonperiodic, much lighter on resources
     microstructure = np.where(np.abs(X)**options.exponent[0] +
                               np.abs(Y)**options.exponent[1] +
-                              np.abs(Z)**options.exponent[2] <= 1.0, options.fill, microstructure)
+                              np.abs(Z)**options.exponent[2] <= 1.0,
+                              options.fill   if options.inside else microstructure,
+                              microstructure if options.inside else options.fill)   
 
   np.seterr(**old_settings) # Reset warnings to old state
-  newInfo['microstructures'] = microstructure.max()
+  newInfo['microstructures'] = len(np.unique(microstructure))
 
 # --- report ---------------------------------------------------------------------------------------
   if (newInfo['microstructures'] != info['microstructures']):
-    damask.util.croak('--> microstructures: %i'%newInfo['microstructures'])
+    damask.util.croak('--> microstructures: {}'.format(newInfo['microstructures']))
 
 
 #--- write header ---------------------------------------------------------------------------------
@@ -225,9 +234,9 @@ for name in filenames:
 
 # --- write microstructure information ------------------------------------------------------------
 
-  formatwidth = int(math.floor(math.log10(microstructure.max())+1))
+  format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure))+1)))
   table.data = microstructure.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose()
-  table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
+  table.data_writeArray(format,delimiter = ' ')
 
 #--- output finalization --------------------------------------------------------------------------
 

processing/pre/geom_canvas.py

@@ -35,7 +35,7 @@ parser.add_option('-f',
                   type = 'float', metavar = 'float',
                   help = '(background) canvas grain index. "0" selects maximum microstructure index + 1 [%default]')
 parser.add_option('--float',
-                  dest = 'real',
+                  dest = 'float',
                   action = 'store_true',
                   help = 'use float input')
 parser.add_option('--blank',
@@ -45,13 +45,13 @@ parser.add_option('--blank',
 
 parser.set_defaults(grid = ['0','0','0'],
                     offset = (0,0,0),
-                    fill = 0,
+                    fill = 0.0,
-                    real = False,
+                    float = False,
                    )
 
 (options, filenames) = parser.parse_args()
 
-datatype = 'f' if options.real else 'i'
+datatype = 'f' if options.float else 'i'
 options.grid = ['1','1','1'] if options.blank and options.grid == ['0','0','0'] else options.grid
 options.fill = 1 if options.blank and options.fill == 0 else options.fill
 
@@ -107,7 +107,7 @@ for name in filenames:
   newInfo['grid'] = np.where(newInfo['grid'] > 0, newInfo['grid'],info['grid'])
 
   microstructure_cropped = np.zeros(newInfo['grid'],datatype)
-  microstructure_cropped.fill(options.fill if options.real or options.fill > 0 else microstructure.max()+1)
+  microstructure_cropped.fill(options.fill if options.float or options.fill > 0 else np.nanmax(microstructure)+1)
   
   if not options.blank:
     xindex = np.arange(max(options.offset[0],0),min(options.offset[0]+newInfo['grid'][0],info['grid'][0]))
@@ -130,7 +130,7 @@ for name in filenames:
   newInfo['size']   = info['size']/info['grid']*newInfo['grid'] if np.all(info['grid'] > 0) else newInfo['grid']
   newInfo['origin'] = info['origin']+(info['size']/info['grid'] if np.all(info['grid'] > 0) \
                               else newInfo['size']/newInfo['grid'])*options.offset
-  newInfo['microstructures'] = microstructure_cropped.max()
+  newInfo['microstructures'] = len(np.unique(microstructure_cropped))
 
 # --- report ---------------------------------------------------------------------------------------
 
@@ -172,7 +172,7 @@ for name in filenames:
 
 # --- write microstructure information ------------------------------------------------------------
 
-  format = '%g' if options.real else '%{}i'.format(int(math.floor(math.log10(microstructure_cropped.max())+1)))
+  format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure_cropped))+1)))
   table.data = microstructure_cropped.reshape((newInfo['grid'][0],newInfo['grid'][1]*newInfo['grid'][2]),order='F').transpose()
   table.data_writeArray(format,delimiter=' ')
     

processing/pre/geom_clean.py

@@ -50,13 +50,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  {}'.format(' x '.join(map(str,info['grid']))),
-                     'size     x y z:  {}'.format(' x '.join(map(str,info['size']))),
-                     'origin   x y z:  {}'.format(' : '.join(map(str,info['origin']))),
-                     'homogenization:  {}'.format(info['homogenization']),
-                     'microstructures: {}'.format(info['microstructures']),
-                    ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
@@ -73,7 +67,7 @@ for name in filenames:
 # --- do work ------------------------------------------------------------------------------------
 
   microstructure = ndimage.filters.generic_filter(microstructure,mostFrequent,size=(options.stencil,)*3).astype('int_')
-  newInfo = {'microstructures': microstructure.max()}
+  newInfo = {'microstructures': len(np.unique(microstructure))}
 
 # --- report ---------------------------------------------------------------------------------------
   if (    newInfo['microstructures'] != info['microstructures']):
@@ -91,9 +85,9 @@ for name in filenames:
 
 # --- write microstructure information ------------------------------------------------------------
 
-  formatwidth = int(math.floor(math.log10(microstructure.max())+1))
+  formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1))
   table.data = microstructure.reshape((info['grid'][0],np.prod(info['grid'][1:])),order='F').transpose()
-  table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
+  table.data_writeArray('%{}i'.format(formatwidth),delimiter = ' ')
 
 # --- output finalization --------------------------------------------------------------------------
 

processing/pre/geom_fromMinimalSurface.py

@@ -90,12 +90,7 @@ for name in filenames:
 
 #--- report ---------------------------------------------------------------------------------------
 
-  damask.util.croak(['grid     a b c:  %s'%(' x '.join(map(str,info['grid']))),
+  damask.util.report_geom(info)
-               'size     x y z:  %s'%(' x '.join(map(str,info['size']))),
-               'origin   x y z:  %s'%(' : '.join(map(str,info['origin']))),
-               'homogenization:  %i'%info['homogenization'],
-               'microstructures: %i'%info['microstructures'],
-              ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')

processing/pre/geom_fromTable.py

@@ -192,12 +192,7 @@ for name in filenames:
           'homogenization':  options.homogenization,
          }
 
-  damask.util.croak(['grid     a b c:  {}'.format(' x '.join(map(str,info['grid']))),
+  damask.util.report_geom(info)
-                     'size     x y z:  {}'.format(' x '.join(map(str,info['size']))),
-                     'origin   x y z:  {}'.format(' : '.join(map(str,info['origin']))),
-                     'homogenization:  {}'.format(info['homogenization']),
-                     'microstructures: {}'.format(info['microstructures']),
-                    ])
     
 # --- write header ---------------------------------------------------------------------------------
 
@@ -230,7 +225,7 @@ for name in filenames:
 # --- write microstructure information ------------------------------------------------------------
 
   table.data = grain.reshape(info['grid'][1]*info['grid'][2],info['grid'][0])
-  table.data_writeArray('%%%ii'%(formatwidth),delimiter=' ')
+  table.data_writeArray('%{}i'.format(formatwidth),delimiter=' ')
   
 #--- output finalization --------------------------------------------------------------------------
 

processing/pre/geom_grainGrowth.py

@@ -69,13 +69,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-  
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  {}'.format(' x '.join(list(map(str,info['grid'])))),
-                     'size     x y z:  {}'.format(' x '.join(list(map(str,info['size'])))),
-                     'origin   x y z:  {}'.format(' : '.join(list(map(str,info['origin'])))),
-                     'homogenization:  {}'.format(info['homogenization']),
-                     'microstructures: {}'.format(info['microstructures']),
-                    ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
@@ -200,8 +194,7 @@ for name in filenames:
         newID += 1
         microstructure = np.where(microstructure == microstructureID, newID, microstructure)
 
-  newInfo = {'microstructures': 0,}
+  newInfo = {'microstructures': len(np.unique(microstructure)),}
-  newInfo['microstructures'] = microstructure.max()
 
 # --- report --------------------------------------------------------------------------------------
 
@@ -226,7 +219,7 @@ for name in filenames:
 
 # --- write microstructure information ------------------------------------------------------------
 
-  formatwidth = int(math.floor(math.log10(microstructure.max())+1))
+  formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1))
   table.data = microstructure[::1 if info['grid'][0]>1 else 2,
                               ::1 if info['grid'][1]>1 else 2,
                               ::1 if info['grid'][2]>1 else 2,].\

processing/pre/geom_mirror.py

@@ -23,6 +23,13 @@ parser.add_option('-d','--direction',
                   dest = 'directions',
                   action = 'extend', metavar = '<string LIST>',
                   help = "directions in which to mirror {'x','y','z'}")
+parser.add_option('--float',
+                  dest = 'float',
+                  action = 'store_true',
+                  help = 'use float input')
+
+parser.set_defaults(float = False,
+                   )
 
 (options, filenames) = parser.parse_args()
 
@@ -32,6 +39,8 @@ if not set(options.directions).issubset(validDirections):
   invalidDirections = [str(e) for e in set(options.directions).difference(validDirections)]
   parser.error('invalid directions {}. '.format(*invalidDirections))
 
+datatype = 'f' if options.float else 'i'
+
 # --- loop over input files -------------------------------------------------------------------------
 
 if filenames == []: filenames = [None]
@@ -39,7 +48,8 @@ if filenames == []: filenames = [None]
 for name in filenames:
   try:
     table = damask.ASCIItable(name = name,
-                              buffered = False, labeled = False)
+                              buffered = False,
+                              labeled = False)
   except: continue
   damask.util.report(scriptName,name)
 
@@ -47,13 +57,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  %s'%(' x '.join(map(str,info['grid']))),
-                     'size     x y z:  %s'%(' x '.join(map(str,info['size']))),
-                     'origin   x y z:  %s'%(' : '.join(map(str,info['origin']))),
-                     'homogenization:  %i'%info['homogenization'],
-                     'microstructures: %i'%info['microstructures'],
-                    ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
@@ -65,7 +69,7 @@ for name in filenames:
 
 # --- read data ------------------------------------------------------------------------------------
 
-  microstructure = table.microstructure_read(info['grid']).reshape(info['grid'],order='F')          # read microstructure
+  microstructure = table.microstructure_read(info['grid'],datatype).reshape(info['grid'],order='F')  # read microstructure
 
   if 'z' in options.directions:
     microstructure = np.concatenate([microstructure,microstructure[:,:,::-1]],2)
@@ -107,9 +111,9 @@ for name in filenames:
 
 # --- write microstructure information ------------------------------------------------------------
 
-  formatwidth = int(math.floor(math.log10(microstructure.max())+1))
+  formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1))
   table.data = microstructure.reshape((newInfo['grid'][0],np.prod(newInfo['grid'][1:])),order='F').transpose()
-  table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
+  table.data_writeArray('%{}i'.format(formatwidth),delimiter = ' ')
 
 # --- output finalization --------------------------------------------------------------------------
 

processing/pre/geom_pack.py

@@ -35,14 +35,8 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-  
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  {}'.format(' x '.join(map(str,info['grid']))),
+ 
-                     'size     x y z:  {}'.format(' x '.join(map(str,info['size']))),
-                     'origin   x y z:  {}'.format(' : '.join(map(str,info['origin']))),
-                     'homogenization:  {}'.format(info['homogenization']),
-                     'microstructures: {}'.format(info['microstructures']),
-                    ])
-
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
   if np.any(info['size'] <= 0.0): errors.append('invalid size x y z.')

processing/pre/geom_renumber.py

@@ -35,13 +35,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  %s'%(' x '.join(map(str,info['grid']))),
-               'size     x y z:  %s'%(' x '.join(map(str,info['size']))),
-               'origin   x y z:  %s'%(' : '.join(map(str,info['origin']))),
-               'homogenization:  %i'%info['homogenization'],
-               'microstructures: %i'%info['microstructures'],
-              ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
@@ -93,7 +87,7 @@ for name in filenames:
 
 # --- write microstructure information -----------------------------------------------------------
 
-  format = '%{}i'.format(int(math.floor(math.log10(newInfo['microstructures'])+1)))
+  format = '%{}i'.format(int(math.floor(math.log10(np.nanmax(renumbered))+1)))
   table.data = renumbered.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose()
   table.data_writeArray(format,delimiter = ' ')
 

processing/pre/geom_rescale.py

@@ -31,14 +31,21 @@ parser.add_option('-r', '--renumber',
                   dest = 'renumber',
                   action = 'store_true',
                   help = 'renumber microstructure indices from 1..N [%default]')
+parser.add_option('--float',
+                  dest = 'float',
+                  action = 'store_true',
+                  help = 'use float input')
 
 parser.set_defaults(renumber = False,
                     grid = ['0','0','0'],
                     size  = ['0.0','0.0','0.0'],
+                    float = False,
                    )
 
 (options, filenames) = parser.parse_args()
 
+datatype = 'f' if options.float else 'i'
+
 # --- loop over input files -------------------------------------------------------------------------
 
 if filenames == []: filenames = [None]
@@ -46,7 +53,8 @@ if filenames == []: filenames = [None]
 for name in filenames:
   try:
     table = damask.ASCIItable(name = name,
-                              buffered = False, labeled = False)
+                              buffered = False,
+                              labeled = False)
   except: continue
   damask.util.report(scriptName,name)
 
@@ -54,13 +62,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-  
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  %s'%(' x '.join(map(str,info['grid']))),
-               'size     x y z:  %s'%(' x '.join(map(str,info['size']))),
-               'origin   x y z:  %s'%(' : '.join(map(str,info['origin']))),
-               'homogenization:  %i'%info['homogenization'],
-               'microstructures: %i'%info['microstructures'],
-              ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
@@ -72,7 +74,7 @@ for name in filenames:
 
 # --- read data ------------------------------------------------------------------------------------
 
-  microstructure = table.microstructure_read(info['grid'])                                          # read microstructure
+  microstructure = table.microstructure_read(info['grid'],datatype)                                   # read microstructure
 
 # --- do work ------------------------------------------------------------------------------------
  
@@ -113,7 +115,7 @@ for name in filenames:
         newID += 1
         microstructure = np.where(microstructure == microstructureID, newID,microstructure).reshape(microstructure.shape)
 
-  newInfo['microstructures'] = microstructure.max()
+  newInfo['microstructures'] = len(np.unique(microstructure))
 
 # --- report ---------------------------------------------------------------------------------------
 
@@ -152,9 +154,9 @@ for name in filenames:
   
 # --- write microstructure information ------------------------------------------------------------
 
-  formatwidth = int(math.floor(math.log10(microstructure.max())+1))
+  format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure))+1)))
   table.data = microstructure.reshape((newInfo['grid'][0],newInfo['grid'][1]*newInfo['grid'][2]),order='F').transpose()
-  table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
+  table.data_writeArray(format,delimiter=' ')
     
 # --- output finalization --------------------------------------------------------------------------
 

processing/pre/geom_rotate.py

@@ -43,9 +43,15 @@ parser.add_option('-f', '--fill',
                   dest = 'fill',
                   type = 'int', metavar = 'int',
                   help = 'background grain index. "0" selects maximum microstructure index + 1 [%default]')
+parser.add_option('--float',
+                  dest = 'float',
+                  action = 'store_true',
+                  help = 'use float input')
 
 parser.set_defaults(degrees = False,
-                    fill = 0)
+                    fill = 0,
+                    float = False,
+                   )
 
 (options, filenames) = parser.parse_args()
 
@@ -61,6 +67,8 @@ if options.matrix is not None:
 if options.eulers is not None:
   eulers = damask.Rotation.fromEulers(np.array(options.eulers),degrees=True).asEulers(degrees=True)
 
+datatype = 'f' if options.float else 'i'
+
 # --- loop over input files -------------------------------------------------------------------------
 
 if filenames == []: filenames = [None]
@@ -77,13 +85,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  {}'.format(' x '.join(map(str,info['grid']))),
-                     'size     x y z:  {}'.format(' x '.join(map(str,info['size']))),
-                     'origin   x y z:  {}'.format(' : '.join(map(str,info['origin']))),
-                     'homogenization:  {}'.format(info['homogenization']),
-                     'microstructures: {}'.format(info['microstructures']),
-                    ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
@@ -95,9 +97,9 @@ for name in filenames:
 
 # --- read data ------------------------------------------------------------------------------------
 
-  microstructure = table.microstructure_read(info['grid']).reshape(info['grid'],order='F')                    # read microstructure
+  microstructure = table.microstructure_read(info['grid'],datatype).reshape(info['grid'],order='F')                  # read microstructure
 
-  newGrainID = options.fill if options.fill != 0 else microstructure.max()+1
+  newGrainID = options.fill if options.fill != 0 else np.nanmax(microstructure)+1
   microstructure = ndimage.rotate(microstructure,eulers[2],(0,1),order=0,prefilter=False,output=int,cval=newGrainID) # rotation around Z
   microstructure = ndimage.rotate(microstructure,eulers[1],(1,2),order=0,prefilter=False,output=int,cval=newGrainID) # rotation around X
   microstructure = ndimage.rotate(microstructure,eulers[0],(0,1),order=0,prefilter=False,output=int,cval=newGrainID) # rotation around Z
@@ -107,19 +109,18 @@ for name in filenames:
   newInfo = {
              'size':   microstructure.shape*info['size']/info['grid'],
              'grid':   microstructure.shape,
-             'microstructures': microstructure.max(),
+             'microstructures': len(np.unique(microstructure)),
             }
 
-
 # --- report ---------------------------------------------------------------------------------------
 
   remarks = []
   if (any(newInfo['grid']            != info['grid'])):
-    remarks.append('--> grid    a b c:  %s'%(' x '.join(map(str,newInfo['grid']))))
+    remarks.append('--> grid    a b c:  {}'.format(' x '.join(map(str,newInfo['grid']))))
   if (any(newInfo['size']            != info['size'])):
-    remarks.append('--> size    x y z:  %s'%(' x '.join(map(str,newInfo['size']))))
+    remarks.append('--> size    x y z:  {}'.format(' x '.join(map(str,newInfo['size']))))
   if (    newInfo['microstructures'] != info['microstructures']): 
-    remarks.append('--> microstructures: %i'%newInfo['microstructures'])
+    remarks.append('--> microstructures: {}'.format(newInfo['microstructures']))
   if remarks != []: damask.util.croak(remarks)
 
 # --- write header ---------------------------------------------------------------------------------
@@ -138,9 +139,9 @@ for name in filenames:
 
 # --- write microstructure information ------------------------------------------------------------
 
-  formatwidth = int(math.floor(math.log10(microstructure.max())+1))
+  format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(microstructure))+1)))
   table.data = microstructure.reshape((newInfo['grid'][0],np.prod(newInfo['grid'][1:])),order='F').transpose()
-  table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
+  table.data_writeArray(format,delimiter=' ')
 
 # --- output finalization --------------------------------------------------------------------------
 

processing/pre/geom_toTable.py

@@ -20,15 +20,15 @@ Translate geom description into ASCIItable containing position and microstructur
 """, version = scriptID)
 
 parser.add_option('--float',
-                  dest = 'real',
+                  dest = 'float',
                   action = 'store_true',
                   help = 'use float input')
 
-parser.set_defaults(real = False,
+parser.set_defaults(float = False,
                    )
 (options, filenames) = parser.parse_args()
 
-datatype = 'f' if options.real else 'i'
+datatype = 'f' if options.float else 'i'
 
 # --- loop over input files -------------------------------------------------------------------------
 
@@ -47,13 +47,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-  
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  {}'.format(' x '.join(list(map(str,info['grid'])))),
-                     'size     x y z:  {}'.format(' x '.join(list(map(str,info['size'])))),
-                     'origin   x y z:  {}'.format(' : '.join(list(map(str,info['origin'])))),
-                     'homogenization:  {}'.format(info['homogenization']),
-                     'microstructures: {}'.format(info['microstructures']),
-                    ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')

processing/pre/geom_translate.py

@@ -31,19 +31,19 @@ parser.add_option('-s', '--substitute',
                   action = 'extend', metavar = '<string LIST>',
                   help = 'substitutions of microstructure indices from,to,from,to,...')
 parser.add_option('--float',
-                  dest = 'real',
+                  dest = 'float',
                   action = 'store_true',
                   help = 'use float input')
 
 parser.set_defaults(origin = (0.0,0.0,0.0),
                     microstructure = 0,
                     substitute = [],
-                    real = False,
+                    float = False,
                    )
 
 (options, filenames) = parser.parse_args()
 
-datatype = 'f' if options.real else 'i'
+datatype = 'f' if options.float else 'i'
 
 sub = {}
 for i in range(len(options.substitute)//2):                                                         # split substitution list into "from" -> "to"
@@ -64,13 +64,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  %s'%(' x '.join(map(str,info['grid']))),
-               'size     x y z:  %s'%(' x '.join(map(str,info['size']))),
-               'origin   x y z:  %s'%(' : '.join(map(str,info['origin']))),
-               'homogenization:  %i'%info['homogenization'],
-               'microstructures: %i'%info['microstructures'],
-              ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
@@ -92,7 +86,7 @@ for name in filenames:
             }
 
   substituted = np.copy(microstructure)
-  for k, v in sub.items(): substituted[microstructure==k] = v                                   # substitute microstructure indices
+  for k, v in sub.items(): substituted[microstructure==k] = v                                       # substitute microstructure indices
 
   substituted += options.microstructure                                                             # shift microstructure indices
 
@@ -103,9 +97,9 @@ for name in filenames:
 
   remarks = []
   if (any(newInfo['origin']          != info['origin'])):
-    remarks.append('--> origin   x y z:  %s'%(' : '.join(map(str,newInfo['origin']))))
+    remarks.append('--> origin   x y z:  {}'.format(' : '.join(map(str,newInfo['origin']))))
   if (    newInfo['microstructures'] != info['microstructures']):
-    remarks.append('--> microstructures: %i'%newInfo['microstructures'])
+    remarks.append('--> microstructures: {}'.format(newInfo['microstructures']))
   if remarks != []: damask.util.croak(remarks)
 
 # --- write header -------------------------------------------------------------------------------
@@ -124,7 +118,7 @@ for name in filenames:
 
 # --- write microstructure information -----------------------------------------------------------
 
-  format = '%g' if options.real else '%{}i'.format(int(math.floor(math.log10(microstructure.max())+1)))
+  format = '%g' if options.float else '%{}i'.format(int(math.floor(math.log10(np.nanmax(substituted))+1)))
   table.data = substituted.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose()
   table.data_writeArray(format,delimiter = ' ')
 

processing/pre/geom_unpack.py

@@ -43,13 +43,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-  
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  %s'%(' x '.join(map(str,info['grid']))),
-               'size     x y z:  %s'%(' x '.join(map(str,info['size']))),
-               'origin   x y z:  %s'%(' : '.join(map(str,info['origin']))),
-               'homogenization:  %i'%info['homogenization'],
-               'microstructures: %i'%info['microstructures'],
-              ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')

processing/pre/geom_vicinityOffset.py

@@ -73,13 +73,7 @@ for name in filenames:
 
   table.head_read()
   info,extra_header = table.head_getGeom()
-  
+  damask.util.report_geom(info)
-  damask.util.croak(['grid     a b c:  %s'%(' x '.join(map(str,info['grid']))),
-               'size     x y z:  %s'%(' x '.join(map(str,info['size']))),
-               'origin   x y z:  %s'%(' : '.join(map(str,info['origin']))),
-               'homogenization:  %i'%info['homogenization'],
-               'microstructures: %i'%info['microstructures'],
-              ])
 
   errors = []
   if np.any(info['grid'] < 1):    errors.append('invalid grid a b c.')
@@ -108,7 +102,7 @@ for name in filenames:
                                                            extra_keywords={"trigger":options.trigger,"size":1+2*options.vicinity}),
                             microstructure + options.offset,microstructure)
 
-  newInfo['microstructures'] = microstructure.max()
+  newInfo['microstructures'] = len(np.unique(microstructure))
 
 # --- report ---------------------------------------------------------------------------------------
 
@@ -131,9 +125,9 @@ for name in filenames:
   
 # --- write microstructure information ------------------------------------------------------------
 
-  formatwidth = int(math.floor(math.log10(microstructure.max())+1))
+  formatwidth = int(math.floor(math.log10(np.nanmax(microstructure))+1))
   table.data = microstructure.reshape((info['grid'][0],info['grid'][1]*info['grid'][2]),order='F').transpose()
-  table.data_writeArray('%%%ii'%(formatwidth),delimiter = ' ')
+  table.data_writeArray('%{}i'.format(formatwidth),delimiter = ' ')
     
 # --- output finalization --------------------------------------------------------------------------
 

python/damask/dadf5.py

@@ -48,16 +48,24 @@ class DADF5():
         for o in f['inc{:05}/constituent/{}'.format(self.increments[0]['inc'],c)].keys():
           self.c_output_types.append(o)
       self.c_output_types = list(set(self.c_output_types))                                          # make unique
+
+      self.m_output_types = []
+      for m in self.materialpoints:
+        for o in f['inc{:05}/materialpoint/{}'.format(self.increments[0]['inc'],m)].keys():
+          self.m_output_types.append(o)
+      self.m_output_types = list(set(self.m_output_types))                                          # make unique
       
     self.active= {'increments':     self.increments,
                   'constituents':   self.constituents,
                   'materialpoints': self.materialpoints,
                   'constituent':    self.Nconstituents,
-                  'c_output_types': self.c_output_types}
+                  'c_output_types': self.c_output_types,
+                  'm_output_types': self.m_output_types}
 
     self.filename   = filename
     self.mode       = mode
-    
+
+
   def list_data(self):
     """Shows information on all datasets in the file"""
     with h5py.File(self.filename,'r') as f:
@@ -73,6 +81,16 @@ class DADF5():
               print('    {} ({})'.format(x,f[group_output_types+'/'+x].attrs['Description'].decode()))
           except:
             pass
+      for m in self.active['materialpoints']:
+        group_materialpoint = group_inc+'/materialpoint/'+m
+        for t in self.active['m_output_types']:
+          print('  {}'.format(t))
+          group_output_types = group_materialpoint+'/'+t
+          try:
+            for x in f[group_output_types].keys():
+              print('    {} ({})'.format(x,f[group_output_types+'/'+x].attrs['Description'].decode()))
+          except:
+            pass
     
 
   def get_dataset_location(self,label):
@@ -81,14 +99,25 @@ class DADF5():
     with h5py.File(self.filename,'r') as f:
       for i in self.active['increments']:
         group_inc = 'inc{:05}'.format(i['inc'])
+        
         for c in self.active['constituents']:
           group_constituent = group_inc+'/constituent/'+c
           for t in self.active['c_output_types']:
             try:
               f[group_constituent+'/'+t+'/'+label]
               path.append(group_constituent+'/'+t+'/'+label)
-            except:
+            except Exception as e:
-              pass
+              print('unable to locate constituents dataset: '+ str(e))
+       
+        for m in self.active['materialpoints']:
+          group_materialpoint = group_inc+'/materialpoint/'+m
+          for t in self.active['m_output_types']:
+            try:
+              f[group_materialpoint+'/'+t+'/'+label]
+              path.append(group_materialpoint+'/'+t+'/'+label)
+            except Exception as e:
+              print('unable to locate materialpoints dataset: '+ str(e))
+              
     return path
     
     
@@ -100,13 +129,29 @@ class DADF5():
     """
     with h5py.File(self.filename,'r') as f:
       shape = (self.Nmaterialpoints,) + np.shape(f[path[0]])[1:]
+      if len(shape) == 1: shape = shape +(1,)
       dataset = np.full(shape,np.nan)
       for pa in path:
         label   = pa.split('/')[2]
-        p = np.where(f['mapping/cellResults/constituent'][:,c]['Name'] == str.encode(label))[0]
+        try:
-        u = (f['mapping/cellResults/constituent'][p,c]['Position'])
+          p = np.where(f['mapping/cellResults/constituent'][:,c]['Name'] == str.encode(label))[0]
-        dataset[p,:] = f[pa][u,:]                                                    
+          u = (f['mapping/cellResults/constituent'][p,c]['Position'])
-    
+          a = np.array(f[pa])
+          if len(a.shape) == 1:
+            a=a.reshape([a.shape[0],1])
+          dataset[p,:] = a[u,:]
+        except Exception as e:
+          print('unable to read constituent: '+ str(e))
+        try:
+          p = np.where(f['mapping/cellResults/materialpoint']['Name'] == str.encode(label))[0]
+          u = (f['mapping/cellResults/materialpoint'][p.tolist()]['Position'])
+          a = np.array(f[pa])
+          if len(a.shape) == 1:
+            a=a.reshape([a.shape[0],1])
+          dataset[p,:] = a[u,:]
+        except Exception as e:
+          print('unable to read materialpoint: '+ str(e))
+
     return dataset
         
       

python/damask/orientation.py

@@ -227,12 +227,17 @@ class Rotation:
       return cls(ax2qu(ax))
       
     @classmethod
-    def fromMatrix(cls,
+    def fromBasis(cls,
-                   matrix,
+                  basis,
-                   containsStretch = False):                                 #ToDo: better name?
+                  orthonormal = True,
+                  reciprocal = False,
+                 ):
       
-      om = matrix if isinstance(matrix, np.ndarray) else np.array(matrix).reshape((3,3))            # ToDo: Reshape here or require explicit?
+      om = basis if isinstance(basis, np.ndarray) else np.array(basis).reshape((3,3))
-      if containsStretch:
+      if reciprocal:
+        om = np.linalg.inv(om.T/np.pi)                                                              # transform reciprocal basis set
+        orthonormal = False                                                                         # contains stretch
+      if not orthonormal:
         (U,S,Vh) = np.linalg.svd(om)                                                                # singular value decomposition
         om = np.dot(U,Vh)     
       if not np.isclose(np.linalg.det(om),1.0):
@@ -244,6 +249,13 @@ class Rotation:
 
       return cls(om2qu(om))
       
+    @classmethod
+    def fromMatrix(cls,
+                   om,
+                  ):
+      
+      return cls.fromBasis(om)
+      
     @classmethod
     def fromRodrigues(cls,
                       rodrigues,

src/CPFEM.f90

@@ -4,9 +4,7 @@
 !> @brief CPFEM engine
 !--------------------------------------------------------------------------------------------------
 module CPFEM
- use prec, only: &
+ use prec
-   pReal, &
-   pInt
 
  implicit none
  private
@@ -57,8 +55,6 @@ contains
 !> @brief call (thread safe) all module initializations
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_initAll(el,ip)
- use prec, only: &
-   prec_init
  use numerics, only: &
    numerics_init
  use debug, only: &
@@ -91,7 +87,6 @@ subroutine CPFEM_initAll(el,ip)
    IO_init
  use DAMASK_interface
 
- implicit none
  integer(pInt), intent(in) ::                        el, &                                          !< FE el number
                                                      ip                                             !< FE integration point number
 
@@ -155,7 +150,6 @@ subroutine CPFEM_init
    crystallite_Li0, &
    crystallite_S0
 
- implicit none
  integer :: k,l,m,ph,homog
 
  write(6,'(/,a)')   ' <<<+-  CPFEM init  -+>>>'
@@ -325,7 +319,6 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt
    IO_warning
  use DAMASK_interface
 
- implicit none
  integer(pInt), intent(in) ::                        elFE, &                                        !< FE element number
                                                      ip                                             !< integration point number
  real(pReal), intent(in) ::                          dt                                             !< time increment
@@ -639,8 +632,6 @@ end subroutine CPFEM_general
 !> @brief triggers writing of the results
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_results(inc,time)
- use prec, only: &
-   pInt
 #ifdef DAMASK_HDF5
  use results
  use HDF5_utilities
@@ -650,7 +641,6 @@ subroutine CPFEM_results(inc,time)
  use crystallite, only: &
    crystallite_results
 
- implicit none
  integer(pInt), intent(in) :: inc
  real(pReal),   intent(in) :: time
 

src/CPFEM2.f90

@@ -12,6 +12,7 @@ module CPFEM2
    CPFEM_age, &
    CPFEM_initAll, &
    CPFEM_results
+
 contains
 
 
@@ -20,7 +21,6 @@ contains
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_initAll()
  use prec, only: &
-   pInt, &
    prec_init
  use numerics, only: &
    numerics_init
@@ -57,8 +57,6 @@ subroutine CPFEM_initAll()
    FEM_Zoo_init
 #endif
 
- implicit none
-
  call DAMASK_interface_init                                                                         ! Spectral and FEM interface to commandline
  call prec_init
  call IO_init
@@ -87,8 +85,6 @@ end subroutine CPFEM_initAll
 !> @brief allocate the arrays defined in module CPFEM and initialize them
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_init
- use prec, only: &
-   pInt, pReal
  use IO, only: &
    IO_error
  use numerics, only: &
@@ -124,8 +120,8 @@ subroutine CPFEM_init
  use DAMASK_interface, only: &
    getSolverJobName
 
- implicit none
+ 
- integer(pInt) :: ph,homog
+ integer :: ph,homog
  character(len=1024) :: rankStr, PlasticItem, HomogItem
  integer(HID_T) :: fileHandle, groupPlasticID, groupHomogID
 
@@ -134,7 +130,7 @@ subroutine CPFEM_init
 
  ! *** restore the last converged values of each essential variable from the binary file
  if (restartRead) then
-   if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0_pInt) then
+   if (iand(debug_level(debug_CPFEM), debug_levelExtensive) /= 0) then
      write(6,'(a)') '<< CPFEM >> restored state variables of last converged step from hdf5 file'
      flush(6)
    endif
@@ -152,14 +148,14 @@ subroutine CPFEM_init
    call HDF5_read(fileHandle,crystallite_S0,      'convergedS')
    
    groupPlasticID = HDF5_openGroup(fileHandle,'PlasticPhases')
-   do ph = 1_pInt,size(phase_plasticity)
+   do ph = 1,size(phase_plasticity)
     write(PlasticItem,*) ph,'_'
     call HDF5_read(groupPlasticID,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
    enddo
    call HDF5_closeGroup(groupPlasticID)
    
    groupHomogID = HDF5_openGroup(fileHandle,'HomogStates')
-   do homog = 1_pInt, material_Nhomogenization
+   do homog = 1, material_Nhomogenization
     write(HomogItem,*) homog,'_'
     call HDF5_read(groupHomogID,homogState(homog)%state0, trim(HomogItem)//'convergedStateHomog')
    enddo
@@ -178,8 +174,7 @@ end subroutine CPFEM_init
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_age()
  use prec, only: &
-   pReal, &
+   pReal
-   pInt
  use numerics, only: &
    worldrank
  use debug, only: &
@@ -223,13 +218,12 @@ subroutine CPFEM_age()
  use hdf5
  use DAMASK_interface, only: &
    getSolverJobName
-
+ 
- implicit none
+ integer    ::  i, ph, homog, mySource
- integer(pInt)    ::  i, ph, homog, mySource
  character(len=32) :: rankStr, PlasticItem, HomogItem
  integer(HID_T) :: fileHandle, groupPlastic, groupHomog
 
- if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
+ if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
    write(6,'(a)') '<< CPFEM >> aging states'
 
  crystallite_F0  = crystallite_partionedF
@@ -246,14 +240,14 @@ subroutine CPFEM_age()
    do mySource = 1,phase_Nsources(i)
      sourceState(i)%p(mySource)%state0 = sourceState(i)%p(mySource)%state
  enddo; enddo
- do homog = 1_pInt, material_Nhomogenization
+ do homog = 1, material_Nhomogenization
    homogState       (homog)%state0 =  homogState       (homog)%state
    thermalState     (homog)%state0 =  thermalState     (homog)%state
    damageState      (homog)%state0 =  damageState      (homog)%state
  enddo
 
  if (restartWrite) then
-   if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
+   if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
      write(6,'(a)') '<< CPFEM >> writing restart variables of last converged step to hdf5 file'
    
    write(rankStr,'(a1,i0)')'_',worldrank
@@ -268,14 +262,14 @@ subroutine CPFEM_age()
    call HDF5_write(fileHandle,crystallite_S0,      'convergedS')
    
    groupPlastic = HDF5_addGroup(fileHandle,'PlasticPhases')
-   do ph = 1_pInt,size(phase_plasticity)
+   do ph = 1,size(phase_plasticity)
      write(PlasticItem,*) ph,'_'
      call HDF5_write(groupPlastic,plasticState(ph)%state0,trim(PlasticItem)//'convergedStateConst')
    enddo
    call HDF5_closeGroup(groupPlastic)
 
    groupHomog = HDF5_addGroup(fileHandle,'HomogStates')
-   do homog = 1_pInt, material_Nhomogenization
+   do homog = 1, material_Nhomogenization
      write(HomogItem,*) homog,'_'
      call HDF5_write(groupHomog,homogState(homog)%state0,trim(HomogItem)//'convergedStateHomog')
    enddo
@@ -285,7 +279,7 @@ subroutine CPFEM_age()
    restartWrite = .false.
  endif
 
- if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) &
+ if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0) &
    write(6,'(a)') '<< CPFEM >> done aging states'
 
 end subroutine CPFEM_age
@@ -295,23 +289,23 @@ end subroutine CPFEM_age
 !> @brief triggers writing of the results
 !--------------------------------------------------------------------------------------------------
 subroutine CPFEM_results(inc,time)
- use prec, only: &
-   pInt
  use results
  use HDF5_utilities
+  use homogenization, only: &
+   homogenization_results
  use constitutive, only: &
    constitutive_results
  use crystallite, only: &
    crystallite_results
-
+ 
- implicit none
+ integer, intent(in) :: inc
- integer(pInt), intent(in) :: inc
  real(pReal),   intent(in) :: time
 
  call results_openJobFile
  call results_addIncrement(inc,time)
  call constitutive_results
  call crystallite_results
+ call homogenization_results
  call results_removeLink('current') ! ToDo: put this into closeJobFile
  call results_closeJobFile
 

src/DAMASK_interface.f90

@@ -14,7 +14,11 @@
 #define PETSC_MAJOR 3
 #define PETSC_MINOR_MIN 10
 #define PETSC_MINOR_MAX 11
+
 module DAMASK_interface
+  use, intrinsic :: iso_fortran_env
+  use PETScSys
+
   use prec
   use system_routines
   
@@ -50,9 +54,6 @@ contains
 !! information on computation to screen
 !--------------------------------------------------------------------------------------------------
 subroutine DAMASK_interface_init
-  use, intrinsic :: iso_fortran_env
-  use PETScSys
-
 #include <petsc/finclude/petscsys.h>
 #if defined(__GFORTRAN__) &&  __GNUC__<GCC_MIN
 ===================================================================================================

src/DAMASK_marc.f90

@@ -96,14 +96,12 @@ end subroutine DAMASK_interface_init
 !> @brief solver job name (no extension) as combination of geometry and load case name
 !--------------------------------------------------------------------------------------------------
 function getSolverJobName()
- use prec, only: &
+ use prec
-   pReal, &
-   pInt
 
  implicit none
  character(1024) :: getSolverJobName, inputName
  character(len=*), parameter :: pathSep = achar(47)//achar(92)                                      ! forward and backward slash
- integer(pInt) :: extPos
+ integer :: extPos
 
  getSolverJobName=''
  inputName=''
@@ -133,9 +131,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
                    dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, &
                    strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, &
                    jtype,lclass,ifr,ifu)
- use prec, only: &
+ use prec
-   pReal, &
-   pInt
  use numerics, only: &
 !$ DAMASK_NumThreadsInt, &
    numerics_unitlength, &
@@ -180,7 +176,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
 
  implicit none
 !$ include "omp_lib.h"                                                                              ! the openMP function library
- integer(pInt),                         intent(in) :: &                                             ! according to MSC.Marc 2012 Manual D
+ integer,                               intent(in) :: &                                             ! according to MSC.Marc 2012 Manual D
    ngens, &                                                                                         !< size of stress-strain law
    nn, &                                                                                            !< integration point number
    ndi, &                                                                                           !< number of direct components
@@ -193,7 +189,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
    jtype, &                                                                                         !< element type
    ifr, &                                                                                           !< set to 1 if R has been calculated
    ifu                                                                                              !< set to 1 if stretch has been calculated
- integer(pInt), dimension(2),           intent(in) :: &                                             ! according to MSC.Marc 2012 Manual D
+ integer, dimension(2),                 intent(in) :: &                                             ! according to MSC.Marc 2012 Manual D
    m, &                                                                                             !< (1) user element number, (2) internal element number
    matus, &                                                                                         !< (1) user material identification number, (2) internal material identification number
    kcus, &                                                                                          !< (1) layer number, (2) internal layer number
@@ -236,10 +232,10 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
  logical :: cutBack
  real(pReal), dimension(6) ::   stress
  real(pReal), dimension(6,6) :: ddsdde
- integer(pInt) :: computationMode, i, cp_en, node, CPnodeID
+ integer :: computationMode, i, cp_en, node, CPnodeID
  !$ integer(4) :: defaultNumThreadsInt                                                              !< default value set by Marc
 
- if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0_pInt) then
+ if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0) then
    write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn
    write(6,'(a,2(i1))')      ' Jacobian:                      ', ngens,ngens
    write(6,'(a,i1)')         ' Direct stress:                 ', ndi
@@ -260,7 +256,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
 
  !$ call omp_set_num_threads(DAMASK_NumThreadsInt)                                                  ! set number of threads for parallel execution set by DAMASK_NUM_THREADS
 
- computationMode = 0_pInt                                                                           ! save initialization value, since it does not result in any calculation
+ computationMode = 0                                                                                ! save initialization value, since it does not result in any calculation
  if (lovl == 4 ) then                                                                               ! jacobian requested by marc
    if (timinc < theDelta .and. theInc == inc .and. lastLovl /= lovl) &                              ! first after cutback
      computationMode = CPFEM_RESTOREJACOBIAN
@@ -307,7 +303,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
        if (lastLovl /= lovl) then                                                                   ! first after ping pong
          call debug_reset()                                                                         ! resets debugging
          outdatedFFN1  = .false.
-         cycleCounter  = cycleCounter + 1_pInt
+         cycleCounter  = cycleCounter + 1
          mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes)                            ! update cell node coordinates
          call mesh_build_ipCoordinates()                                                            ! update ip coordinates
        endif
@@ -324,7 +320,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
          lastIncConverged = .false.                                                                 ! reset flag
        endif
        do node = 1,theMesh%elem%nNodes
-         CPnodeID = mesh_element(4_pInt+node,cp_en)
+         CPnodeID = mesh_element(4+node,cp_en)
          mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
        enddo
      endif
@@ -336,7 +332,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
          call debug_info()                                                                          ! first reports (meaningful) debugging
        call debug_reset()                                                                           ! and resets debugging
        outdatedFFN1  = .false.
-       cycleCounter  = cycleCounter + 1_pInt
+       cycleCounter  = cycleCounter + 1
        mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes)                              ! update cell node coordinates
        call mesh_build_ipCoordinates()                                                              ! update ip coordinates
      endif
@@ -376,22 +372,20 @@ end subroutine hypela2
 !> @brief calculate internal heat generated due to inelastic energy dissipation
 !--------------------------------------------------------------------------------------------------
 subroutine flux(f,ts,n,time)
- use prec, only: &
+ use prec
-   pReal, &
-   pInt
  use thermal_conduction, only: &
    thermal_conduction_getSourceAndItsTangent
  use mesh, only: &
    mesh_FEasCP
 
  implicit none
- real(pReal),   dimension(6),           intent(in) :: &
+ real(pReal), dimension(6),           intent(in) :: &
    ts
- integer(pInt), dimension(10),          intent(in) :: &
+ integer,     dimension(10),          intent(in) :: &
    n
- real(pReal),                           intent(in) :: &
+ real(pReal),                         intent(in) :: &
    time
- real(pReal),   dimension(2),           intent(out) :: &
+ real(pReal), dimension(2),           intent(out) :: &
    f
 
  call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEasCP('elem',n(1)))
@@ -404,9 +398,7 @@ subroutine flux(f,ts,n,time)
 !> @details select a variable contour plotting (user subroutine).
 !--------------------------------------------------------------------------------------------------
 subroutine uedinc(inc,incsub)
-  use prec, only: &
+  use prec
-    pReal, &
-    pInt
   use CPFEM, only: &
     CPFEM_results
 
@@ -424,9 +416,7 @@ end subroutine uedinc
 !> @details select a variable contour plotting (user subroutine).
 !--------------------------------------------------------------------------------------------------
 subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
- use prec, only: &
+ use prec
-   pReal, &
-   pInt
  use mesh, only: &
    mesh_FEasCP
  use IO, only: &
@@ -436,7 +426,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
    materialpoint_sizeResults
 
  implicit none
- integer(pInt),               intent(in) :: &
+ integer,               intent(in) :: &
    m, &                                                                                             !< element number
    nn, &                                                                                            !< integration point number
    layer, &                                                                                         !< layer number
@@ -453,7 +443,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
  real(pReal),                 intent(out) :: &
    v                                                                                                !< variable
 
- if (jpltcd > materialpoint_sizeResults) call IO_error(700_pInt,jpltcd)                             ! complain about out of bounds error
+ if (jpltcd > materialpoint_sizeResults) call IO_error(700,jpltcd)                                  ! complain about out of bounds error
  v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m))
 
 end subroutine plotv

src/FEsolving.f90

@@ -5,14 +5,12 @@
 !> @todo Descriptions for public variables needed
 !--------------------------------------------------------------------------------------------------
 module FEsolving
- use prec, only: &
+ use prec
-   pInt, &
+  
-   pReal
- 
  implicit none
  private
- integer(pInt), public :: &
+ integer, public :: &
-   restartInc   =  1_pInt                                                                           !< needs description
+   restartInc   =  1                                                                                !< needs description
 
  logical, public :: & 
    symmetricSolver   = .false., &                                                                   !< use a symmetric FEM solver
@@ -20,10 +18,10 @@ module FEsolving
    restartRead       = .false., &                                                                   !< restart information to continue calculation from saved state
    terminallyIll     = .false.                                                                      !< at least one material point is terminally ill
 
- integer(pInt), dimension(:,:), allocatable, public :: &
+ integer, dimension(:,:), allocatable, public :: &
    FEsolving_execIP                                                                                 !< for ping-pong scheme always range to max IP, otherwise one specific IP
    
- integer(pInt), dimension(2), public :: &
+ integer, dimension(2), public :: &
    FEsolving_execElem                                                                               !< for ping-pong scheme always whole range, otherwise one specific element
    
  character(len=1024), public :: &
@@ -59,13 +57,12 @@ subroutine FE_init
    IO_warning
  use DAMASK_interface
  
- implicit none
 #if defined(Marc4DAMASK) || defined(Abaqus)
- integer(pInt), parameter :: &
+ integer, parameter :: &
-   FILEUNIT = 222_pInt
+   FILEUNIT = 222
- integer(pInt) :: j
+ integer :: j
  character(len=65536) :: tag, line
- integer(pInt), allocatable, dimension(:) :: chunkPos
+ integer, allocatable, dimension(:) :: chunkPos
 #endif
 
  write(6,'(/,a)')   ' <<<+-  FEsolving init  -+>>>'
@@ -75,35 +72,35 @@ subroutine FE_init
 #if defined(Grid) || defined(FEM)
  restartInc = interface_RestartInc
 
- if(restartInc < 0_pInt) then
+ if(restartInc < 0) then
-   call IO_warning(warning_ID=34_pInt)
+   call IO_warning(warning_ID=34)
-   restartInc = 0_pInt
+   restartInc = 0
  endif
- restartRead = restartInc > 0_pInt                                                                  ! only read in if "true" restart requested
+ restartRead = restartInc > 0                                                                       ! only read in if "true" restart requested
 #else
  call IO_open_inputFile(FILEUNIT,modelName)
  rewind(FILEUNIT)
  do
    read (FILEUNIT,'(a1024)',END=100) line
    chunkPos = IO_stringPos(line)
-   tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                               ! extract key
+   tag = IO_lc(IO_stringValue(line,chunkPos,1))                                                     ! extract key
    select case(tag)
      case ('solver')
        read (FILEUNIT,'(a1024)',END=100) line                                                       ! next line
        chunkPos = IO_stringPos(line)
-       symmetricSolver = (IO_intValue(line,chunkPos,2_pInt) /= 1_pInt)
+       symmetricSolver = (IO_intValue(line,chunkPos,2) /= 1)
      case ('restart')
        read (FILEUNIT,'(a1024)',END=100) line                                                       ! next line
        chunkPos = IO_stringPos(line)
-       restartWrite = iand(IO_intValue(line,chunkPos,1_pInt),1_pInt) > 0_pInt
+       restartWrite = iand(IO_intValue(line,chunkPos,1),1) > 0
-       restartRead  = iand(IO_intValue(line,chunkPos,1_pInt),2_pInt) > 0_pInt
+       restartRead  = iand(IO_intValue(line,chunkPos,1),2) > 0
      case ('*restart')
-       do j=2_pInt,chunkPos(1)
+       do j=2,chunkPos(1)
          restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'write') .or. restartWrite
          restartRead  = (IO_lc(IO_StringValue(line,chunkPos,j)) == 'read')  .or. restartRead
        enddo
        if(restartWrite) then
-         do j=2_pInt,chunkPos(1)
+         do j=2,chunkPos(1)
            restartWrite = (IO_lc(IO_StringValue(line,chunkPos,j)) /= 'frequency=0') .and. restartWrite
          enddo
        endif
@@ -118,11 +115,11 @@ subroutine FE_init
    do
      read (FILEUNIT,'(a1024)',END=200) line
      chunkPos = IO_stringPos(line)
-     if (   IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'restart' &
+     if (   IO_lc(IO_stringValue(line,chunkPos,1)) == 'restart' &
-      .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'file'    &
+      .and. IO_lc(IO_stringValue(line,chunkPos,2)) == 'file'    &
-      .and. IO_lc(IO_stringValue(line,chunkPos,3_pInt)) == 'job'     &
+      .and. IO_lc(IO_stringValue(line,chunkPos,3)) == 'job'     &
-      .and. IO_lc(IO_stringValue(line,chunkPos,4_pInt)) == 'id' )    &
+      .and. IO_lc(IO_stringValue(line,chunkPos,4)) == 'id' )    &
-        modelName = IO_StringValue(line,chunkPos,6_pInt)
+        modelName = IO_StringValue(line,chunkPos,6)
    enddo
 #else                                                                                               ! QUESTION: is this meaningful for the spectral/FEM case?
    call IO_open_inputFile(FILEUNIT,modelName)
@@ -130,10 +127,10 @@ subroutine FE_init
    do
      read (FILEUNIT,'(a1024)',END=200) line
      chunkPos = IO_stringPos(line)
-     if (IO_lc(IO_stringValue(line,chunkPos,1_pInt))=='*heading') then
+     if (IO_lc(IO_stringValue(line,chunkPos,1))=='*heading') then
        read (FILEUNIT,'(a1024)',END=200) line
        chunkPos = IO_stringPos(line)
-       modelName = IO_StringValue(line,chunkPos,1_pInt)
+       modelName = IO_StringValue(line,chunkPos,1)
      endif
    enddo
 #endif
@@ -141,7 +138,7 @@ subroutine FE_init
  endif
 
 #endif
- if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0_pInt) then
+ if (iand(debug_level(debug_FEsolving),debug_levelBasic) /= 0) then
    write(6,'(a21,l1)') ' restart writing:    ', restartWrite
    write(6,'(a21,l1)') ' restart reading:    ', restartRead
    if (restartRead) write(6,'(a,/)') ' restart Job:        '//trim(modelName)

src/HDF5_utilities.f90

@@ -8,6 +8,8 @@ module HDF5_utilities
   use prec
   use IO
   use HDF5
+  use rotations
+  use numerics
 #ifdef PETSc
   use PETSC
 #endif
@@ -1676,8 +1678,6 @@ end subroutine HDF5_write_int7
 ! ToDo: We could optionally write out other representations (axis angle, euler, ...)
 !--------------------------------------------------------------------------------------------------
 subroutine HDF5_write_rotation(loc_id,dataset,datasetName,parallel)
-  use rotations, only: &
-    rotation
 
   type(rotation),   intent(in), dimension(:) :: dataset
   integer(HID_T),   intent(in) :: loc_id                                                            !< file or group handle
@@ -1754,9 +1754,6 @@ end subroutine HDF5_write_rotation
 subroutine initialize_read(dset_id, filespace_id, memspace_id, plist_id, aplist_id, &
                            myStart, globalShape, &
                            loc_id,localShape,datasetName,parallel)
- use numerics, only: &
-   worldrank, &
-   worldsize
 
  integer(HID_T),    intent(in) :: loc_id                                                             !< file or group handle
  character(len=*),  intent(in) :: datasetName                                                        !< name of the dataset in the file
@@ -1850,9 +1847,6 @@ end subroutine finalize_read
 subroutine initialize_write(dset_id, filespace_id, memspace_id, plist_id, &
                            myStart, totalShape, &
                            loc_id,myShape,datasetName,datatype,parallel)
- use numerics, only: &
-   worldrank, &
-   worldsize
 
  integer(HID_T),    intent(in) :: loc_id                                                             !< file or group handle
  character(len=*),  intent(in) :: datasetName                                                        !< name of the dataset in the file

src/Lambert.f90

@@ -38,11 +38,13 @@
 !> Modeling and Simulations in Materials Science and Engineering 22, 075013 (2014).
 !--------------------------------------------------------------------------
 module Lambert
+  use prec
   use math
 
   implicit none
   private
-  real(pReal), parameter, private :: &
+  
+  real(pReal), parameter :: &
     SPI  = sqrt(PI), &
     PREF = sqrt(6.0_pReal/PI), &
     A    = PI**(5.0_pReal/6.0_pReal)/6.0_pReal**(1.0_pReal/6.0_pReal), &
@@ -55,10 +57,8 @@ module Lambert
     PREK = R1 * 2.0_pReal**(1.0_pReal/4.0_pReal)/BETA
  
   public :: &
-    LambertCubeToBall, &
+    Lambert_CubeToBall, &
-    LambertBallToCube
+    Lambert_BallToCube
-  private :: &
-   GetPyramidOrder
 
 contains
 
@@ -68,7 +68,7 @@ contains
 !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
 !> @brief map from 3D cubic grid to 3D ball 
 !--------------------------------------------------------------------------
-function LambertCubeToBall(cube) result(ball)
+function Lambert_CubeToBall(cube) result(ball)
  
   real(pReal), intent(in), dimension(3) :: cube
   real(pReal),             dimension(3) :: ball, LamXYZ, XYZ
@@ -116,7 +116,7 @@ function LambertCubeToBall(cube) result(ball)
  
   endif center
 
-end function LambertCubeToBall
+end function Lambert_CubeToBall
 
 
 !--------------------------------------------------------------------------
@@ -124,7 +124,7 @@ end function LambertCubeToBall
 !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
 !> @brief map from 3D ball to 3D cubic grid  
 !--------------------------------------------------------------------------
-pure function LambertBallToCube(xyz) result(cube)
+pure function Lambert_BallToCube(xyz) result(cube)
  
   real(pReal), intent(in), dimension(3) :: xyz
   real(pReal),             dimension(3) :: cube, xyz1, xyz3
@@ -170,7 +170,7 @@ pure function LambertBallToCube(xyz) result(cube)
  
   endif center
 
-end function LambertBallToCube
+end function Lambert_BallToCube
 
 
 !--------------------------------------------------------------------------

src/commercialFEM_fileList.f90

@@ -46,7 +46,6 @@
 #include "plastic_nonlocal.f90"
 #include "constitutive.f90"
 #include "crystallite.f90"
-#include "homogenization_mech_RGC.f90"
 #include "thermal_isothermal.f90"
 #include "thermal_adiabatic.f90"
 #include "thermal_conduction.f90"
@@ -56,4 +55,5 @@
 #include "homogenization.f90"
 #include "homogenization_mech_none.f90"
 #include "homogenization_mech_isostrain.f90"
+#include "homogenization_mech_RGC.f90"
 #include "CPFEM.f90"

src/config.f90

@@ -6,12 +6,14 @@
 !! parts 'homogenization', 'crystallite', 'phase', 'texture', and 'microstucture'
 !--------------------------------------------------------------------------------------------------
 module config
-  use prec, only: &
+  use prec
-    pReal
+  use DAMASK_interface
-  use list, only: &
+  use IO
-    tPartitionedStringList
+  use debug
+  use list
 
   implicit none
+  private
 
   type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: &
     config_phase, &
@@ -20,10 +22,11 @@ module config
     config_texture, &
     config_crystallite
    
-   type(tPartitionedStringList), public, protected :: &
+  type(tPartitionedStringList), public, protected :: &
     config_numerics, &
     config_debug
  
+  !ToDo: bad names (how should one know that those variables are defined in config?)
   character(len=64), dimension(:), allocatable, public, protected :: &
     phase_name, &                                                                                   !< name of each phase
     homogenization_name, &                                                                          !< name of each homogenization
@@ -47,22 +50,9 @@ contains
 !> @brief reads material.config and stores its content per part
 !--------------------------------------------------------------------------------------------------
 subroutine config_init
-  use prec, only: &
-    pStringLen
-  use DAMASK_interface, only: &
-    getSolverJobName
-  use IO, only: &
-    IO_read_ASCII, &
-    IO_error, &
-    IO_lc, &
-    IO_getTag
-  use debug, only: &
-    debug_level, &
-    debug_material, &
-    debug_levelBasic
 
-  implicit none
+  integer :: i
-  integer :: myDebug,i
+  logical :: verbose
 
   character(len=pStringLen) :: &
     line, &
@@ -72,7 +62,7 @@ subroutine config_init
 
   write(6,'(/,a)') ' <<<+-  config init  -+>>>'
 
-  myDebug = debug_level(debug_material)
+  verbose = iand(debug_level(debug_material),debug_levelBasic) /= 0
 
   inquire(file=trim(getSolverJobName())//'.materialConfig',exist=fileExists)
   if(fileExists) then
@@ -92,23 +82,23 @@ subroutine config_init
     
       case (trim('phase'))
         call parse_materialConfig(phase_name,config_phase,line,fileContent(i+1:))
-        if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase          parsed'; flush(6)
+        if (verbose) write(6,'(a)') ' Phase          parsed'; flush(6)
     
       case (trim('microstructure'))
         call parse_materialConfig(microstructure_name,config_microstructure,line,fileContent(i+1:))
-        if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6)
+        if (verbose) write(6,'(a)') ' Microstructure parsed'; flush(6)
     
       case (trim('crystallite'))
         call parse_materialConfig(crystallite_name,config_crystallite,line,fileContent(i+1:))
-        if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite    parsed'; flush(6)
+        if (verbose) write(6,'(a)') ' Crystallite    parsed'; flush(6)
     
       case (trim('homogenization'))
         call parse_materialConfig(homogenization_name,config_homogenization,line,fileContent(i+1:))
-        if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6)
+        if (verbose) write(6,'(a)') ' Homogenization parsed'; flush(6)
     
       case (trim('texture'))
         call parse_materialConfig(texture_name,config_texture,line,fileContent(i+1:))
-        if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture        parsed'; flush(6)
+        if (verbose) write(6,'(a)') ' Texture        parsed'; flush(6)
 
     end select
 
@@ -146,10 +136,7 @@ contains
 !!        Recursion is triggered by "{path/to/inputfile}" in a line
 !--------------------------------------------------------------------------------------------------
 recursive function read_materialConfig(fileName,cnt) result(fileContent)
-  use IO, only: &
-    IO_warning
 
-  implicit none
   character(len=*),          intent(in)                :: fileName
   integer,                   intent(in), optional      :: cnt                                       !< recursion counter
   character(len=pStringLen), dimension(:), allocatable :: fileContent                               !< file content, separated per lines
@@ -231,12 +218,7 @@ end function read_materialConfig
 !--------------------------------------------------------------------------------------------------
 subroutine parse_materialConfig(sectionNames,part,line, &
                                 fileContent)
-  use prec, only: &
-    pStringLen
-  use IO, only: &
-    IO_intOut
 
-  implicit none
   character(len=64),            allocatable, dimension(:), intent(out)   :: sectionNames
   type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part
   character(len=pStringLen),                               intent(inout) :: line
@@ -288,7 +270,7 @@ end subroutine parse_materialConfig
 !--------------------------------------------------------------------------------------------------
 subroutine parse_debugAndNumericsConfig(config_list, &
                                         fileContent)
-  implicit none
+
   type(tPartitionedStringList),              intent(out) :: config_list
   character(len=pStringLen),   dimension(:), intent(in)  :: fileContent
   integer :: i
@@ -306,10 +288,7 @@ end subroutine config_init
 !> @brief deallocates the linked lists that store the content of the configuration files
 !--------------------------------------------------------------------------------------------------
 subroutine config_deallocate(what)
-  use IO, only: &
-    IO_error
 
-  implicit none
   character(len=*), intent(in) :: what
 
   select case(trim(what))

src/crystallite.f90

@@ -9,37 +9,43 @@
 !--------------------------------------------------------------------------------------------------
 
 module crystallite
-  use prec, only: &
+  use prec
-    pReal, &
+  use IO
-    pStringLen
+  use config
-  use rotations, only: &
+  use debug
-    rotation
+  use numerics
-  use FEsolving, only:  &
+  use rotations
-    FEsolving_execElem, &
+  use math
-    FEsolving_execIP
+  use mesh
-  use material, only: &
+  use FEsolving
-    homogenization_Ngrains
+  use material
+  use constitutive
+  use lattice
   use future
+  use plastic_nonlocal
+#if defined(PETSc) || defined(DAMASK_HDF5)
+  use HDF5_utilities
+  use results
+#endif
  
-  implicit none
+  implicit none 
- 
   private
-  character(len=64),         dimension(:,:),          allocatable, private :: &
+  character(len=64),         dimension(:,:),          allocatable :: &
     crystallite_output                                                                              !< name of each post result output
   integer,                                                         public, protected :: &
     crystallite_maxSizePostResults                                                                  !< description not available
   integer,                   dimension(:),            allocatable, public, protected :: &
     crystallite_sizePostResults                                                                     !< description not available
-  integer,                   dimension(:,:),          allocatable, private :: &
+  integer,                   dimension(:,:),          allocatable :: &
     crystallite_sizePostResult                                                                      !< description not available
  
   real(pReal),               dimension(:,:,:),        allocatable, public :: &
     crystallite_dt                                                                                  !< requested time increment of each grain
-  real(pReal),               dimension(:,:,:),        allocatable, private :: &
+  real(pReal),               dimension(:,:,:),        allocatable :: &
     crystallite_subdt, &                                                                            !< substepped time increment of each grain
     crystallite_subFrac, &                                                                          !< already calculated fraction of increment
     crystallite_subStep                                                                             !< size of next integration step
-  type(rotation),            dimension(:,:,:),        allocatable, private :: &
+  type(rotation),            dimension(:,:,:),        allocatable :: &
     crystallite_orientation, &                                                                      !< orientation 
     crystallite_orientation0                                                                        !< initial orientation
   real(pReal),               dimension(:,:,:,:,:),    allocatable, public, protected :: &
@@ -64,7 +70,7 @@ module crystallite
     crystallite_Li, &                                                                               !< current intermediate velocitiy grad (end of converged time step)
     crystallite_Li0, &                                                                              !< intermediate velocitiy grad at start of FE inc
     crystallite_partionedLi0                                                                        !< intermediate velocity grad at start of homog inc
-  real(pReal),                dimension(:,:,:,:,:),    allocatable, private :: &
+  real(pReal),                dimension(:,:,:,:,:),    allocatable :: &
     crystallite_subS0, &                                                                            !< 2nd Piola-Kirchhoff stress vector at start of crystallite inc
     crystallite_invFp, &                                                                            !< inverse of current plastic def grad (end of converged time step)
     crystallite_subFp0,&                                                                            !< plastic def grad at start of crystallite inc
@@ -78,7 +84,7 @@ module crystallite
     crystallite_dPdF                                                                                !< current individual dPdF per grain (end of converged time step)
   logical,                    dimension(:,:,:),         allocatable, public :: &
     crystallite_requested                                                                           !< used by upper level (homogenization) to request crystallite calculation
-  logical,                    dimension(:,:,:),         allocatable, private :: &
+  logical,                    dimension(:,:,:),         allocatable :: &
     crystallite_converged, &                                                                        !< convergence flag
     crystallite_todo, &                                                                             !< flag to indicate need for further computation
     crystallite_localPlasticity                                                                     !< indicates this grain to have purely local constitutive law
@@ -102,14 +108,32 @@ module crystallite
                   neighboringip_ID, &
                   neighboringelement_ID
   end enum
-  integer(kind(undefined_ID)),dimension(:,:),   allocatable,          private :: &
+  integer(kind(undefined_ID)),dimension(:,:),   allocatable :: &
     crystallite_outputID                                                                            !< ID of each post result output
     
-  type, private :: tOutput                                                                          !< new requested output (per phase)
+  type :: tOutput                                                                                   !< new requested output (per phase)
     character(len=65536), allocatable, dimension(:) :: &
       label
   end type tOutput
-  type(tOutput), allocatable, dimension(:), private :: output_constituent
+  type(tOutput), allocatable, dimension(:) :: output_constituent
+  
+  type :: tNumerics
+    integer :: &
+      iJacoLpresiduum, &                                                                            !< frequency of Jacobian update of residuum in Lp
+      nState, &                                                                                     !< state loop limit
+      nStress                                                                                       !< stress loop limit                                                                   
+    real(pReal) :: &
+      subStepMinCryst, &                                                                            !< minimum (relative) size of sub-step allowed during cutback
+      subStepSizeCryst, &                                                                           !< size of first substep when cutback
+      subStepSizeLp, &                                                                              !< size of first substep when cutback in Lp calculation
+      subStepSizeLi, &                                                                              !< size of first substep when cutback in Li calculation
+      stepIncreaseCryst, &                                                                          !< increase of next substep size when previous substep converged
+      rTol_crystalliteState, &                                                                      !< relative tolerance in state loop 
+      rTol_crystalliteStress, &                                                                     !< relative tolerance in stress loop
+      aTol_crystalliteStress                                                                        !< absolute tolerance in stress loop
+  end type tNumerics
+  
+  type(tNumerics) :: num                                                                            ! numerics parameters. Better name?
   
   procedure(), pointer :: integrateState
  
@@ -121,15 +145,6 @@ module crystallite
     crystallite_push33ToRef, &
     crystallite_postResults, &
     crystallite_results
-  private :: &
-    integrateStress, &
-    integrateState, &
-    integrateStateFPI, &
-    integrateStateEuler, &
-    integrateStateAdaptiveEuler, &
-    integrateStateRK4, &
-    integrateStateRKCK45, &
-    stateJump
 
 contains
 
@@ -138,40 +153,6 @@ contains
 !> @brief allocates and initialize per grain variables
 !--------------------------------------------------------------------------------------------------
 subroutine crystallite_init
-#ifdef DEBUG
-  use debug, only: &
-    debug_info, &
-    debug_reset, &
-    debug_level, &
-    debug_crystallite, &
-    debug_levelBasic
-#endif
-  use numerics, only: &
-    numerics_integrator, &
-    worldrank, &
-    usePingPong
-  use math, only: &
-    math_I3, &
-    math_EulerToR, &
-    math_inv33
-  use mesh, only: &
-    theMesh, &
-    mesh_element
-  use IO, only: &
-    IO_stringValue, &
-    IO_write_jobFile, &
-    IO_error
-  use material
-  use config, only: &
-   config_deallocate, &
-   config_crystallite, &
-   config_phase, &
-   crystallite_name
-  use constitutive, only: &
-    constitutive_initialFi, &
-    constitutive_microstructure                                                                     ! derived (shortcut) quantities of given state
- 
-  implicit none
  
   integer, parameter :: FILEUNIT=434
   logical, dimension(:,:), allocatable :: devNull
@@ -242,6 +223,38 @@ subroutine crystallite_init
   allocate(crystallite_sizePostResults(size(config_crystallite)),source=0)
   allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), &
                                       size(config_crystallite)), source=0)
+                                      
+  num%subStepMinCryst        = config_numerics%getFloat('substepmincryst',       defaultVal=1.0e-3_pReal)
+  num%subStepSizeCryst       = config_numerics%getFloat('substepsizecryst',      defaultVal=0.25_pReal)
+  num%stepIncreaseCryst      = config_numerics%getFloat('stepincreasecryst',     defaultVal=1.5_pReal)
+  
+  num%subStepSizeLp          = config_numerics%getFloat('substepsizelp',         defaultVal=0.5_pReal)
+  num%subStepSizeLi          = config_numerics%getFloat('substepsizeli',         defaultVal=0.5_pReal)
+
+  num%rTol_crystalliteState  = config_numerics%getFloat('rtol_crystallitestate', defaultVal=1.0e-6_pReal)
+  num%rTol_crystalliteStress = config_numerics%getFloat('rtol_crystallitestress',defaultVal=1.0e-6_pReal)
+  num%aTol_crystalliteStress = config_numerics%getFloat('atol_crystallitestress',defaultVal=1.0e-8_pReal)
+  
+  num%iJacoLpresiduum        = config_numerics%getInt  ('ijacolpresiduum',       defaultVal=1)
+  
+  num%nState                 = config_numerics%getInt  ('nstate',                defaultVal=20)
+  num%nStress                = config_numerics%getInt  ('nstress',               defaultVal=40)
+  
+  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%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%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_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%iJacoLpresiduum < 1)                 call IO_error(301,ext_msg='iJacoLpresiduum')
+  
+  if(num%nState < 1)                          call IO_error(301,ext_msg='nState')
+  if(num%nStress< 1)                          call IO_error(301,ext_msg='nStress')
  
   select case(numerics_integrator)
     case(1)
@@ -430,40 +443,7 @@ end subroutine crystallite_init
 !> @brief calculate stress (P)
 !--------------------------------------------------------------------------------------------------
 function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
-  use prec, only: &
-    tol_math_check, &
-    dNeq0
-  use numerics, only: &
-    subStepMinCryst, &
-    subStepSizeCryst, &
-    stepIncreaseCryst
-#ifdef DEBUG
-  use debug, only: &
-    debug_level, &
-    debug_crystallite, &
-    debug_levelBasic, &
-    debug_levelExtensive, &
-    debug_levelSelective, &
-    debug_e, &
-    debug_i, &
-    debug_g
-#endif
-  use IO, only: &
-    IO_warning, &
-    IO_error
-  use math, only: &
-    math_inv33
-  use mesh, only: &
-    theMesh, &
-    mesh_element
-  use material, only: &
-    homogenization_Ngrains, &
-    plasticState, &
-    sourceState, &
-    phase_Nsources, &
-    phaseAt, phasememberAt
  
-  implicit none
   logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress
   real(pReal), intent(in), optional :: &
     dummyArgumentToPreventInternalCompilerErrorWithGCC
@@ -519,7 +499,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
         crystallite_subF0(1:3,1:3,c,i,e)  = crystallite_partionedF0(1:3,1:3,c,i,e)
         crystallite_subS0(1:3,1:3,c,i,e)  = crystallite_partionedS0(1:3,1:3,c,i,e)
         crystallite_subFrac(c,i,e) = 0.0_pReal
-        crystallite_subStep(c,i,e) = 1.0_pReal/subStepSizeCryst
+        crystallite_subStep(c,i,e) = 1.0_pReal/num%subStepSizeCryst
         crystallite_todo(c,i,e) = .true.
         crystallite_converged(c,i,e) = .false.                                                      ! pretend failed step of 1/subStepSizeCryst
       endif homogenizationRequestsCalculation
@@ -554,7 +534,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
             formerSubStep = crystallite_subStep(c,i,e)
             crystallite_subFrac(c,i,e) = crystallite_subFrac(c,i,e) + crystallite_subStep(c,i,e)
             crystallite_subStep(c,i,e) = min(1.0_pReal - crystallite_subFrac(c,i,e), &
-                                             stepIncreaseCryst * crystallite_subStep(c,i,e))
+                                             num%stepIncreaseCryst * crystallite_subStep(c,i,e))
 
             crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > 0.0_pReal                        ! still time left to integrate on?
             if (crystallite_todo(c,i,e)) then
@@ -584,7 +564,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
 !--------------------------------------------------------------------------------------------------
 !  cut back (reduced time and restore)
           else
-            crystallite_subStep(c,i,e)       = subStepSizeCryst * crystallite_subStep(c,i,e)
+            crystallite_subStep(c,i,e)       = num%subStepSizeCryst * crystallite_subStep(c,i,e)
             crystallite_Fp   (1:3,1:3,c,i,e) =            crystallite_subFp0(1:3,1:3,c,i,e)
             crystallite_invFp(1:3,1:3,c,i,e) = math_inv33(crystallite_Fp    (1:3,1:3,c,i,e))
             crystallite_Fi   (1:3,1:3,c,i,e) =            crystallite_subFi0(1:3,1:3,c,i,e)
@@ -602,7 +582,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
             enddo
 
                                                                                                     ! cant restore dotState here, since not yet calculated in first cutback after initialization
-            crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > subStepMinCryst                  ! still on track or already done (beyond repair)
+            crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > num%subStepMinCryst              ! still on track or already done (beyond repair)
 #ifdef DEBUG
             if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0 &
                .and. ((e == debug_e .and. i == debug_i .and. c == debug_g) &
@@ -652,7 +632,7 @@ function crystallite_stress(dummyArgumentToPreventInternalCompilerErrorWithGCC)
 !--------------------------------------------------------------------------------------------------
 !  integrate --- requires fully defined state array (basic + dependent state)
     if (any(crystallite_todo)) call integrateState                                                  ! TODO: unroll into proper elementloop to avoid N^2 for single point evaluation
-    where(.not. crystallite_converged .and. crystallite_subStep > subStepMinCryst) &                ! do not try non-converged but fully cutbacked any further
+    where(.not. crystallite_converged .and. crystallite_subStep > num%subStepMinCryst) &            ! do not try non-converged but fully cutbacked any further
       crystallite_todo = .true.                                                                     ! TODO: again unroll this into proper elementloop to avoid N^2 for single point evaluation
 
 
@@ -702,33 +682,8 @@ end function crystallite_stress
 !--------------------------------------------------------------------------------------------------
 !> @brief calculate tangent (dPdF)
 !--------------------------------------------------------------------------------------------------
-subroutine crystallite_stressTangent()
+subroutine crystallite_stressTangent
-  use prec, only: &
-    tol_math_check, &
-    dNeq0
-  use IO, only: &
-    IO_warning, &
-    IO_error
-  use math, only: &
-    math_inv33, &
-    math_identity2nd, &
-    math_3333to99, &
-    math_99to3333, &
-    math_I3, &
-    math_mul3333xx3333, &
-    math_mul33xx33, &
-    math_invert2, &
-    math_det33
-  use mesh, only: &
-    mesh_element
-  use material, only: &
-    homogenization_Ngrains
-  use constitutive, only:  &
-    constitutive_SandItsTangents, &
-    constitutive_LpAndItsTangents, &
-    constitutive_LiAndItsTangents
 
-  implicit none
   integer :: &
     c, &                                                                                            !< counter in integration point component loop
     i, &                                                                                            !< counter in integration point loop
@@ -868,21 +823,7 @@ end subroutine crystallite_stressTangent
 !> @brief calculates orientations
 !--------------------------------------------------------------------------------------------------
 subroutine crystallite_orientations
-  use math, only: &
-    math_rotationalPart33, &
-    math_RtoQ
-  use material, only: &
-    plasticState, &
-    material_phase, &
-    homogenization_Ngrains
-  use mesh, only: &
-    mesh_element
-  use lattice, only: &
-    lattice_qDisorientation
-  use plastic_nonlocal, only: &
-    plastic_nonlocal_updateCompatibility
  
-  implicit none
   integer &
     c, &                                                                                            !< counter in integration point component loop
     i, &                                                                                            !< counter in integration point loop
@@ -919,7 +860,6 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33)
   use material, only: &
    material_EulerAngles                                                                             ! ToDo: Why stored? We also have crystallite_orientation0
  
-  implicit none
   real(pReal), dimension(3,3) :: crystallite_push33ToRef
   real(pReal), dimension(3,3), intent(in) :: tensor33
   real(pReal), dimension(3,3)             :: T
@@ -939,30 +879,7 @@ end function crystallite_push33ToRef
 !> @brief return results of particular grain
 !--------------------------------------------------------------------------------------------------
 function crystallite_postResults(ipc, ip, el)
- use math, only: &
-   math_det33, &
-   math_I3, &
-   inDeg
- use mesh, only: &
-   theMesh, &
-   mesh_element, &
-   mesh_ipVolume, &
-   mesh_ipNeighborhood
- use material, only: &
-   plasticState, &
-   sourceState, &
-   microstructure_crystallite, &
-   crystallite_Noutput, &
-   material_phase, &
-   material_texture, &
-   homogenization_Ngrains
- use constitutive, only: &
-   constitutive_homogenizedC, &
-   constitutive_postResults
- use rotations, only: &
-   rotation
 
- implicit none
  integer, intent(in):: &
    el, &                         !< element index
    ip, &                         !< integration point index
@@ -1079,17 +996,9 @@ end function crystallite_postResults
 !--------------------------------------------------------------------------------------------------
 subroutine crystallite_results
 #if defined(PETSc) || defined(DAMASK_HDF5)
-  use lattice
-  use results
-  use HDF5_utilities
-  use rotations
   use config, only: &
     config_name_phase => phase_name                                                                  ! anticipate logical name
    
-  use material, only: &
-    material_phase_plasticity_type => phase_plasticity
-        
-  implicit none
   integer :: p,o
   real(pReal),    allocatable, dimension(:,:,:) :: selected_tensors
   type(rotation), allocatable, dimension(:)     :: selected_rotations
@@ -1229,41 +1138,7 @@ end subroutine crystallite_results
 !> intermediate acceleration of the Newton-Raphson correction
 !--------------------------------------------------------------------------------------------------
 logical function integrateStress(ipc,ip,el,timeFraction)
-  use, intrinsic :: &
-    IEEE_arithmetic
-  use prec, only:         tol_math_check, &
-                          dEq0
-  use numerics, only:     nStress, &
-                          aTol_crystalliteStress, &
-                          rTol_crystalliteStress, &
-                          iJacoLpresiduum, &
-                          subStepSizeLp, &
-                          subStepSizeLi
-#ifdef DEBUG
-  use debug, only:        debug_level, &
-                          debug_e, &
-                          debug_i, &
-                          debug_g, &
-                          debug_crystallite, &
-                          debug_levelBasic, &
-                          debug_levelExtensive, &
-                          debug_levelSelective
-#endif
-
-  use constitutive, only: constitutive_LpAndItsTangents, &
-                          constitutive_LiAndItsTangents, &
-                          constitutive_SandItsTangents
-  use math, only:         math_mul33xx33, &
-                          math_mul3333xx3333, &
-                          math_inv33, &
-                          math_det33, &
-                          math_I3, &
-                          math_identity2nd, &
-                          math_3333to99, &
-                          math_33to9, &
-                          math_9to33
  
-  implicit none
   integer, intent(in)::         el, &                                                               ! element index
                                       ip, &                                                         ! integration point index
                                       ipc                                                           ! grain index
@@ -1382,10 +1257,10 @@ logical function integrateStress(ipc,ip,el,timeFraction)
  
   LiLoop: do
     NiterationStressLi = NiterationStressLi + 1
-    LiLoopLimit: if (NiterationStressLi > nStress) then
+    LiLoopLimit: if (NiterationStressLi > num%nStress) then
 #ifdef DEBUG
       if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) &
-        write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Li loop limit',nStress, &
+        write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Li loop limit',num%nStress, &
                                             ' at el ip ipc ', el,ip,ipc
 #endif
       return
@@ -1404,10 +1279,10 @@ logical function integrateStress(ipc,ip,el,timeFraction)
  
     LpLoop: do
       NiterationStressLp = NiterationStressLp + 1
-      LpLoopLimit: if (NiterationStressLp > nStress) then
+      LpLoopLimit: if (NiterationStressLp > num%nStress) then
 #ifdef DEBUG
         if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0) &
-           write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Lp loop limit',nStress, &
+           write(6,'(a,i3,a,i8,1x,i2,1x,i3,/)') '<< CRYST integrateStress >> reached Lp loop limit',num%nStress, &
                                                 ' at el ip ipc ', el,ip,ipc
 #endif
         return
@@ -1438,8 +1313,8 @@ logical function integrateStress(ipc,ip,el,timeFraction)
 #endif
 
       !* update current residuum and check for convergence of loop
-      aTolLp = max(rTol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), &           ! absolute tolerance from largest acceptable relative error
+      aTolLp = max(num%rTol_crystalliteStress * max(norm2(Lpguess),norm2(Lp_constitutive)), &       ! absolute tolerance from largest acceptable relative error
-                   aTol_crystalliteStress)                                                          ! minimum lower cutoff
+                   num%aTol_crystalliteStress)                                                      ! minimum lower cutoff
       residuumLp = Lpguess - Lp_constitutive
  
       if (any(IEEE_is_NaN(residuumLp))) then
@@ -1459,7 +1334,7 @@ logical function integrateStress(ipc,ip,el,timeFraction)
         Lpguess_old    = Lpguess
         steplengthLp   = 1.0_pReal                                                                  ! ...proceed with normal step length (calculate new search direction)
       else                                                                                          ! not converged and residuum not improved...
-        steplengthLp = subStepSizeLp * steplengthLp                                                 ! ...try with smaller step length in same direction
+        steplengthLp = num%subStepSizeLp * steplengthLp                                             ! ...try with smaller step length in same direction
         Lpguess      = Lpguess_old + steplengthLp * deltaLp
 #ifdef DEBUG
         if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0 &
@@ -1473,7 +1348,7 @@ logical function integrateStress(ipc,ip,el,timeFraction)
 
 
      !* calculate Jacobian for correction term
-      if (mod(jacoCounterLp, iJacoLpresiduum) == 0) then
+      if (mod(jacoCounterLp, num%iJacoLpresiduum) == 0) then
         do o=1,3; do p=1,3
           dFe_dLp(o,1:3,p,1:3) = A(o,p)*transpose(invFi_new)                                        ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j)
         enddo; enddo
@@ -1537,8 +1412,8 @@ logical function integrateStress(ipc,ip,el,timeFraction)
 #endif
 
     !* update current residuum and check for convergence of loop
-    aTolLi = max(rTol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), &             ! absolute tolerance from largest acceptable relative error
+    aTolLi = max(num%rTol_crystalliteStress * max(norm2(Liguess),norm2(Li_constitutive)), &         ! absolute tolerance from largest acceptable relative error
-                 aTol_crystalliteStress)                                                            ! minimum lower cutoff
+                 num%aTol_crystalliteStress)                                                        ! minimum lower cutoff
     residuumLi = Liguess - Li_constitutive
     if (any(IEEE_is_NaN(residuumLi))) then                                                          ! NaN in residuum...
 #ifdef DEBUG
@@ -1557,13 +1432,13 @@ logical function integrateStress(ipc,ip,el,timeFraction)
       Liguess_old    = Liguess
       steplengthLi   = 1.0_pReal                                                                    ! ...proceed with normal step length (calculate new search direction)
     else                                                                                            ! not converged and residuum not improved...
-      steplengthLi   = subStepSizeLi * steplengthLi                                                 ! ...try with smaller step length in same direction
+      steplengthLi   = num%subStepSizeLi * steplengthLi                                             ! ...try with smaller step length in same direction
       Liguess        = Liguess_old + steplengthLi * deltaLi
       cycle LiLoop
     endif
  
     !* calculate Jacobian for correction term
-    if (mod(jacoCounterLi, iJacoLpresiduum) == 0) then
+    if (mod(jacoCounterLi, num%iJacoLpresiduum) == 0) then
       temp_33     = matmul(matmul(A,B),invFi_current)
       do o=1,3; do p=1,3
         dFe_dLi(1:3,o,1:3,p) = -dt*math_I3(o,p)*temp_33                                             ! dFe_dLp(i,j,k,l) = -dt * A(i,k) invFi(l,j)
@@ -1661,32 +1536,7 @@ end function integrateStress
 !> @brief integrate stress, state with adaptive 1st order explicit Euler method
 !> using Fixed Point Iteration to adapt the stepsize
 !--------------------------------------------------------------------------------------------------
-subroutine integrateStateFPI()
+subroutine integrateStateFPI
-#ifdef DEBUG
- use debug, only:        debug_level, &
-                         debug_e, &
-                         debug_i, &
-                         debug_g, &
-                         debug_crystallite, &
-                         debug_levelBasic, &
-                         debug_levelExtensive, &
-                         debug_levelSelective
-#endif
- use numerics, only: &
-   nState
- use mesh, only: &
-   mesh_element
- use material, only: &
-   plasticState, &
-   sourceState, &
-   phaseAt, phasememberAt, &
-   phase_Nsources, &
-   homogenization_Ngrains
- use constitutive, only: &
-   constitutive_plasticity_maxSizeDotState, &
-   constitutive_source_maxSizeDotState
-
- implicit none
 
  integer :: &
    NiterationState, &                                                                               !< number of iterations in state loop
@@ -1712,7 +1562,7 @@ subroutine integrateStateFPI()
 
  NiterationState = 0
  doneWithIntegration = .false.
- crystalliteLooping: do while (.not. doneWithIntegration .and. NiterationState < nState)
+ crystalliteLooping: do while (.not. doneWithIntegration .and. NiterationState < num%nState)
    NiterationState = NiterationState + 1
 
 #ifdef DEBUG
@@ -1852,7 +1702,6 @@ subroutine integrateStateFPI()
  !--------------------------------------------------------------------------------------------------
  real(pReal) pure function damper(current,previous,previous2)
  
- implicit none
  real(pReal), dimension(:), intent(in) ::&
    current, previous, previous2
  
@@ -1874,11 +1723,7 @@ end subroutine integrateStateFPI
 !--------------------------------------------------------------------------------------------------
 !> @brief integrate state with 1st order explicit Euler method
 !--------------------------------------------------------------------------------------------------
-subroutine integrateStateEuler()
+subroutine integrateStateEuler
- use material, only: &
-   plasticState
-
- implicit none
 
  call update_dotState(1.0_pReal)
  call update_state(1.0_pReal)
@@ -1894,22 +1739,8 @@ end subroutine integrateStateEuler
 !--------------------------------------------------------------------------------------------------
 !> @brief integrate stress, state with 1st order Euler method with adaptive step size
 !--------------------------------------------------------------------------------------------------
-subroutine integrateStateAdaptiveEuler()
+subroutine integrateStateAdaptiveEuler
- use mesh, only: &
-   theMesh, &
-   mesh_element
- use material, only: &
-   homogenization_Ngrains, &
-   plasticState, &
-   sourceState, &
-   phaseAt, phasememberAt, &
-   phase_Nsources, &
-   homogenization_maxNgrains
- use constitutive, only: &
-   constitutive_plasticity_maxSizeDotState, &
-   constitutive_source_maxSizeDotState
 
- implicit none
  integer :: &
    e, &                                                                                             ! element index in element loop
    i, &                                                                                             ! integration point index in ip loop
@@ -2001,17 +1832,8 @@ end subroutine integrateStateAdaptiveEuler
 !> @brief integrate stress, state with 4th order explicit Runge Kutta method
 ! ToDo: This is totally BROKEN: RK4dotState is never used!!!
 !--------------------------------------------------------------------------------------------------
-subroutine integrateStateRK4()
+subroutine integrateStateRK4
- use mesh, only: &
-   mesh_element
- use material, only: &
-   homogenization_Ngrains, &
-   plasticState, &
-   sourceState, &
-   phase_Nsources, &
-   phaseAt, phasememberAt
 
- implicit none
  real(pReal), dimension(4), parameter :: &
    TIMESTEPFRACTION = [0.5_pReal, 0.5_pReal, 1.0_pReal, 1.0_pReal]                                   ! factor giving the fraction of the original timestep used for Runge Kutta Integration
  real(pReal), dimension(4), parameter :: &
@@ -2069,22 +1891,8 @@ end subroutine integrateStateRK4
 !> @brief integrate stress, state with 5th order Runge-Kutta Cash-Karp method with
 !> adaptive step size  (use 5th order solution to advance = "local extrapolation")
 !--------------------------------------------------------------------------------------------------
-subroutine integrateStateRKCK45()
+subroutine integrateStateRKCK45
- use mesh, only: &
-   mesh_element, &
-   theMesh
- use material, only: &
-   homogenization_Ngrains, &
-   plasticState, &
-   sourceState, &
-   phase_Nsources, &
-   phaseAt, phasememberAt, &
-   homogenization_maxNgrains
- use constitutive, only: &
-   constitutive_plasticity_maxSizeDotState, &
-   constitutive_source_maxSizeDotState
 
- implicit none
  real(pReal), dimension(5,5), parameter :: &
    A = reshape([&
      .2_pReal, .075_pReal,   .3_pReal, -11.0_pReal/54.0_pReal,  1631.0_pReal/55296.0_pReal, &
@@ -2252,9 +2060,7 @@ end subroutine integrateStateRKCK45
 !> @brief sets convergence flag for nonlocal calculations
 !> @detail one non-converged nonlocal sets all other nonlocals to non-converged to trigger cut back
 !--------------------------------------------------------------------------------------------------
-subroutine nonlocalConvergenceCheck()
+subroutine nonlocalConvergenceCheck
-
- implicit none
  
  if (any(.not. crystallite_converged .and. .not. crystallite_localPlasticity)) &                    ! any non-local not yet converged (or broken)...
    where( .not. crystallite_localPlasticity) crystallite_converged = .false.
@@ -2267,10 +2073,8 @@ end subroutine nonlocalConvergenceCheck
 ! still .true. is considered as converged
 !> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria
 !--------------------------------------------------------------------------------------------------
-subroutine setConvergenceFlag()
+subroutine setConvergenceFlag
- use mesh, only: &
+
-   mesh_element
- implicit none
  integer :: &
    e, &                                                                                             !< element index in element loop
    i, &                                                                                             !< integration point index in ip loop
@@ -2291,14 +2095,13 @@ end subroutine setConvergenceFlag
  !> @brief determines whether a point is converged
  !--------------------------------------------------------------------------------------------------
  logical pure function converged(residuum,state,aTol)
-  use prec, only: &
-    dEq0
-  use numerics, only: &
-    rTol => rTol_crystalliteState
     
-  implicit none
   real(pReal), intent(in), dimension(:) ::&
     residuum, state, aTol
+  real(pReal) :: &
+    rTol
+
+  rTol = num%rTol_crystalliteState
 
   converged = all(abs(residuum) <= max(aTol, rTol*abs(state)))
 
@@ -2309,9 +2112,7 @@ end subroutine setConvergenceFlag
 !> @brief Standard forwarding of state as state = state0 + dotState * (delta t)
 !--------------------------------------------------------------------------------------------------
 subroutine update_stress(timeFraction)
- use mesh, only: &
+
-   mesh_element
- implicit none
  real(pReal), intent(in) :: &
    timeFraction
  integer :: &
@@ -2341,13 +2142,10 @@ end subroutine update_stress
 !--------------------------------------------------------------------------------------------------
 !> @brief tbd
 !--------------------------------------------------------------------------------------------------
-subroutine update_dependentState()
+subroutine update_dependentState
- use mesh, only: &
-   mesh_element
  use constitutive, only: &
    constitutive_dependentState => constitutive_microstructure
 
- implicit none
  integer ::                                    e, &                                                  ! element index in element loop
                                                i, &                                                  ! integration point index in ip loop
                                                g                                                     ! grain index in grain loop
@@ -2370,15 +2168,7 @@ end subroutine update_dependentState
 !> @brief Standard forwarding of state as state = state0 + dotState * (delta t)
 !--------------------------------------------------------------------------------------------------
 subroutine update_state(timeFraction)
- use material, only: &
-   plasticState, &
-   sourceState, &
-   phase_Nsources, &
-   phaseAt, phasememberAt
- use mesh, only: &
-   mesh_element
 
- implicit none
  real(pReal), intent(in) :: &
    timeFraction
  integer :: &
@@ -2419,19 +2209,7 @@ end subroutine update_state
 !> if NaN occurs, crystallite_todo is set to FALSE. Any NaN in a nonlocal propagates to all others
 !--------------------------------------------------------------------------------------------------
 subroutine update_dotState(timeFraction)
- use, intrinsic :: &
-   IEEE_arithmetic
- use material, only: &
-   plasticState, &
-   sourceState, &
-   phaseAt, phasememberAt, &
-   phase_Nsources
- use mesh, only: &
-   mesh_element
- use constitutive, only: &
-   constitutive_collectDotState
 
- implicit none
  real(pReal), intent(in) :: &
    timeFraction
  integer :: &
@@ -2477,20 +2255,7 @@ end subroutine update_DotState
 
 
 subroutine update_deltaState
- use, intrinsic :: &
+
-   IEEE_arithmetic
- use prec, only: &
-   dNeq0
- use mesh, only: &
-   mesh_element
- use material, only: &
-   plasticState, &
-   sourceState, &
-   phase_Nsources, &
-   phaseAt, phasememberAt
- use constitutive, only: &
-   constitutive_collectDeltaState
- implicit none
  integer :: &
    e, &                                                                                             !< element index in element loop
    i, &                                                                                             !< integration point index in ip loop
@@ -2555,31 +2320,7 @@ end subroutine update_deltaState
 !> returns true, if state jump was successfull or not needed. false indicates NaN in delta state
 !--------------------------------------------------------------------------------------------------
 logical function stateJump(ipc,ip,el)
- use, intrinsic :: &
-   IEEE_arithmetic
- use prec, only: &
-   dNeq0
-#ifdef DEBUG
- use debug, only: &
-   debug_e, &
-   debug_i, &
-   debug_g, &
-   debug_level, &
-   debug_crystallite, &
-   debug_levelExtensive, &
-   debug_levelSelective
-#endif
- use material, only: &
-   plasticState, &
-   sourceState, &
-   phase_Nsources, &
-   phaseAt, phasememberAt
- use mesh, only: &
-   mesh_element
- use constitutive, only: &
-   constitutive_collectDeltaState
 
- implicit none
  integer, intent(in):: &
    el, &                       ! element index
    ip, &                       ! integration point index

src/damage_local.f90

@@ -3,42 +3,43 @@
 !> @brief material subroutine for locally evolving damage field
 !--------------------------------------------------------------------------------------------------
 module damage_local
- use prec, only: &
+ use prec
-   pReal, &
+ use material
-   pInt
+ use numerics
+ use config
 
  implicit none
  private
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
+ 
+ integer,                       dimension(:,:),         allocatable, target, public :: &
    damage_local_sizePostResult                                                            !< size of each post result output
 
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
+ character(len=64),             dimension(:,:),         allocatable, target, public :: &
    damage_local_output                                                                    !< name of each post result output
    
- integer(pInt),                       dimension(:),           allocatable, target, public :: &
+ integer,                       dimension(:),           allocatable, target, public :: &
    damage_local_Noutput                                                                   !< number of outputs per instance of this damage 
 
  enum, bind(c) 
    enumerator :: undefined_ID, &
                  damage_ID
  end enum
- integer(kind(undefined_ID)),         dimension(:,:),         allocatable,          private :: & 
+ integer(kind(undefined_ID)),         dimension(:,:),         allocatable :: & 
    damage_local_outputID                                                                  !< ID of each post result output
    
- type, private :: tParameters
+ type :: tParameters
    integer(kind(undefined_ID)),         dimension(:),   allocatable   :: &
      outputID
  end type tParameters
  
- type(tparameters),          dimension(:), allocatable, private :: &
+ type(tparameters),          dimension(:), allocatable :: &
    param
    
  public :: &
    damage_local_init, &
    damage_local_updateState, &
    damage_local_postResults
- private :: &
+
-   damage_local_getSourceAndItsTangent  
 
 contains
 
@@ -47,26 +48,10 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine damage_local_init
- use material, only: &
-   damage_type, &
-   damage_typeInstance, &
-   homogenization_Noutput, &
-   DAMAGE_local_label, &
-   DAMAGE_local_ID, &
-   material_homogenizationAt, & 
-   mappingHomogenization, & 
-   damageState, &
-   damageMapping, &
-   damage, &
-   damage_initialPhi
- use config, only: &
-   config_homogenization
- 
- implicit none
 
- integer(pInt) :: maxNinstance,homog,instance,o,i
+ integer :: maxNinstance,homog,instance,i
- integer(pInt) :: sizeState
+ integer :: sizeState
- integer(pInt) :: NofMyHomog, h
+ integer :: NofMyHomog, h
   integer(kind(undefined_ID)) :: &
    outputID
  character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
@@ -75,14 +60,14 @@ subroutine damage_local_init
  
  write(6,'(/,a)')   ' <<<+-  damage_'//DAMAGE_local_label//' init  -+>>>'
 
- maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt)
+ maxNinstance = count(damage_type == DAMAGE_local_ID)
- if (maxNinstance == 0_pInt) return
+ if (maxNinstance == 0) return
  
- allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
+ allocate(damage_local_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0)
  allocate(damage_local_output         (maxval(homogenization_Noutput),maxNinstance))
           damage_local_output = ''
  allocate(damage_local_outputID       (maxval(homogenization_Noutput),maxNinstance),source=undefined_ID)
- allocate(damage_local_Noutput        (maxNinstance),                               source=0_pInt) 
+ allocate(damage_local_Noutput        (maxNinstance),                               source=0) 
  
  allocate(param(maxNinstance))
   
@@ -116,7 +101,7 @@ subroutine damage_local_init
 
 
 ! allocate state arrays
-     sizeState = 1_pInt
+     sizeState = 1
      damageState(homog)%sizeState = sizeState
      damageState(homog)%sizePostResults = sum(damage_local_sizePostResult(:,instance))
      allocate(damageState(homog)%state0   (sizeState,NofMyHomog), source=damage_initialPhi(homog))
@@ -138,24 +123,15 @@ end subroutine damage_local_init
 !> @brief  calculates local change in damage field   
 !--------------------------------------------------------------------------------------------------
 function damage_local_updateState(subdt, ip, el)
- use numerics, only: &
-   residualStiffness, &
-   err_damage_tolAbs, &
-   err_damage_tolRel
- use material, only: &
-   material_homogenizationAt, &
-   mappingHomogenization, &
-   damageState
  
- implicit none
+ integer, intent(in) :: &
- integer(pInt), intent(in) :: &
    ip, &                                                                                            !< integration point number
    el                                                                                               !< element number
  real(pReal),   intent(in) :: &
    subdt
- logical,                    dimension(2)  :: &
+ logical,    dimension(2)  :: &
    damage_local_updateState
- integer(pInt) :: &
+ integer :: &
    homog, &
    offset
  real(pReal) :: &
@@ -181,17 +157,6 @@ end function damage_local_updateState
 !> @brief  calculates homogenized local damage driving forces  
 !--------------------------------------------------------------------------------------------------
 subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
- use material, only: &
-   homogenization_Ngrains, &
-   material_homogenizationAt, &
-   phaseAt, &
-   phasememberAt, &
-   phase_source, &
-   phase_Nsources, &
-   SOURCE_damage_isoBrittle_ID, &
-   SOURCE_damage_isoDuctile_ID, &
-   SOURCE_damage_anisoBrittle_ID, &
-   SOURCE_damage_anisoDuctile_ID
  use source_damage_isoBrittle, only: &
    source_damage_isobrittle_getRateAndItsTangent
  use source_damage_isoDuctile, only: &
@@ -201,13 +166,12 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
  use source_damage_anisoDuctile, only: &
    source_damage_anisoductile_getRateAndItsTangent
  
- implicit none
+ integer, intent(in) :: &
- integer(pInt), intent(in) :: &
    ip, &                                                                                            !< integration point number
    el                                                                                               !< element number
  real(pReal),   intent(in) :: &
    phi
- integer(pInt) :: &
+ integer :: &
    phase, &
    grain, &
    source, &
@@ -249,37 +213,32 @@ subroutine damage_local_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el
  
 end subroutine damage_local_getSourceAndItsTangent
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief return array of damage results
 !--------------------------------------------------------------------------------------------------
 function damage_local_postResults(ip,el)
- use material, only: &
-   material_homogenizationAt, &
-   damage_typeInstance, &
-   damageMapping, &
-   damage
 
- implicit none
+ integer,              intent(in) :: &
- integer(pInt),              intent(in) :: &
    ip, &                                                                                            !< integration point
    el                                                                                               !< element
  real(pReal), dimension(sum(damage_local_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
    damage_local_postResults
 
- integer(pInt) :: &
+ integer :: &
    instance, homog, offset, o, c
    
  homog     = material_homogenizationAt(el)
  offset    = damageMapping(homog)%p(ip,el)
  instance  = damage_typeInstance(homog)
  associate(prm => param(instance))
- c = 0_pInt
+ c = 0
 
- outputsLoop: do o = 1_pInt,size(prm%outputID)
+ outputsLoop: do o = 1,size(prm%outputID)
    select case(prm%outputID(o))
  
       case (damage_ID)
-        damage_local_postResults(c+1_pInt) = damage(homog)%p(offset)
+        damage_local_postResults(c+1) = damage(homog)%p(offset)
         c = c + 1
     end select
  enddo outputsLoop

src/damage_none.f90

@@ -3,6 +3,8 @@
 !> @brief material subroutine for constant damage field
 !--------------------------------------------------------------------------------------------------
 module damage_none
+  use config
+  use material
 
   implicit none
   private
@@ -15,19 +17,8 @@ contains
 !--------------------------------------------------------------------------------------------------
 !> @brief allocates all neccessary fields, reads information from material configuration file
 !--------------------------------------------------------------------------------------------------
-subroutine damage_none_init()
+subroutine damage_none_init
-  use config, only: &
+
-    config_homogenization
-  use material, only: &
-    damage_initialPhi, &
-    damage, &
-    damage_type, &
-    material_homogenizationAt, &
-    damageState, &
-    DAMAGE_NONE_LABEL, &
-    DAMAGE_NONE_ID
- 
-  implicit none
   integer :: &
     homog, &
     NofMyHomog

src/damage_nonlocal.f90

@@ -4,41 +4,50 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module damage_nonlocal
- use prec, only: &
+  use prec
-   pReal, &
+  use material
-   pInt
+  use numerics
+  use config
+  use crystallite
+  use lattice
+  use mesh
+  use source_damage_isoBrittle
+  use source_damage_isoDuctile
+  use source_damage_anisoBrittle
+  use source_damage_anisoDuctile
 
- implicit none
+  implicit none
- private
+  private
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
+  
-   damage_nonlocal_sizePostResult                                                            !< size of each post result output
+  integer,                       dimension(:,:),  allocatable, target, public :: &
+    damage_nonlocal_sizePostResult                                                                  !< size of each post result output
 
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
+  character(len=64),             dimension(:,:),   allocatable, target, public :: &
-   damage_nonlocal_output                                                                    !< name of each post result output
+    damage_nonlocal_output                                                                          !< name of each post result output
-   
+    
- integer(pInt),                       dimension(:),           allocatable, target, public :: &
+  integer,                       dimension(:),     allocatable, target, public :: &
-   damage_nonlocal_Noutput                                                                   !< number of outputs per instance of this damage 
+    damage_nonlocal_Noutput                                                                         !< number of outputs per instance of this damage 
 
- enum, bind(c) 
+  enum, bind(c) 
-   enumerator :: undefined_ID, &
+    enumerator :: undefined_ID, &
-                 damage_ID
+                  damage_ID
- end enum
+  end enum
 
- type, private :: tParameters
+  type :: tParameters
-   integer(kind(undefined_ID)),         dimension(:),   allocatable   :: &
+    integer(kind(undefined_ID)),         dimension(:),   allocatable   :: &
-     outputID
+      outputID
- end type tParameters
+  end type tParameters
- 
+  
- type(tparameters),          dimension(:), allocatable, private :: &
+  type(tparameters),          dimension(:), allocatable :: &
-   param
+    param
 
- public :: &
+  public :: &
-   damage_nonlocal_init, &
+    damage_nonlocal_init, &
-   damage_nonlocal_getSourceAndItsTangent, &
+    damage_nonlocal_getSourceAndItsTangent, &
-   damage_nonlocal_getDiffusion33, &
+    damage_nonlocal_getDiffusion33, &
-   damage_nonlocal_getMobility, &
+    damage_nonlocal_getMobility, &
-   damage_nonlocal_putNonLocalDamage, &
+    damage_nonlocal_putNonLocalDamage, &
-   damage_nonlocal_postResults
+    damage_nonlocal_postResults
 
 contains
 
@@ -47,289 +56,228 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine damage_nonlocal_init
- use material, only: &
-   damage_type, &
-   damage_typeInstance, &
-   homogenization_Noutput, &
-   DAMAGE_nonlocal_label, &
-   DAMAGE_nonlocal_ID, &
-   material_homogenizationAt, & 
-   mappingHomogenization, & 
-   damageState, &
-   damageMapping, &
-   damage, &
-   damage_initialPhi
- use config, only: &
-   config_homogenization
 
- implicit none
+  integer :: maxNinstance,homog,instance,o,i
-
+  integer :: sizeState
- integer(pInt) :: maxNinstance,homog,instance,o,i
+  integer :: NofMyHomog, h
- integer(pInt) :: sizeState
- integer(pInt) :: NofMyHomog, h
   integer(kind(undefined_ID)) :: &
-   outputID
+    outputID
- character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
+  character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
-  character(len=65536), dimension(:), allocatable :: &
+   character(len=65536), dimension(:), allocatable :: &
-   outputs
+    outputs
 
- write(6,'(/,a)')   ' <<<+-  damage_'//DAMAGE_nonlocal_label//' init  -+>>>'
+  write(6,'(/,a)')   ' <<<+-  damage_'//DAMAGE_nonlocal_label//' init  -+>>>'
- 
- maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt)
- if (maxNinstance == 0_pInt) return
- 
- allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0_pInt)
- allocate(damage_nonlocal_output         (maxval(homogenization_Noutput),maxNinstance))
-          damage_nonlocal_output = ''
- allocate(damage_nonlocal_Noutput        (maxNinstance),                               source=0_pInt) 
-
- allocate(param(maxNinstance))
   
- do h = 1, size(damage_type)
+  maxNinstance = count(damage_type == DAMAGE_nonlocal_ID)
-   if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle
+  if (maxNinstance == 0) return
-   associate(prm => param(damage_typeInstance(h)), &
+  
-             config => config_homogenization(h))
+  allocate(damage_nonlocal_sizePostResult (maxval(homogenization_Noutput),maxNinstance),source=0)
-             
+  allocate(damage_nonlocal_output         (maxval(homogenization_Noutput),maxNinstance))
-   instance = damage_typeInstance(h)
+           damage_nonlocal_output = ''
-   outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
+  allocate(damage_nonlocal_Noutput        (maxNinstance),                               source=0) 
-   allocate(prm%outputID(0))
+
+  allocate(param(maxNinstance))
    
-   do i=1, size(outputs)
+  do h = 1, size(damage_type)
-     outputID = undefined_ID
+    if (damage_type(h) /= DAMAGE_NONLOCAL_ID) cycle
-     select case(outputs(i))
+    associate(prm => param(damage_typeInstance(h)), &
-     
+              config => config_homogenization(h))
-           case ('damage')
+              
-           damage_nonlocal_output(i,damage_typeInstance(h)) = outputs(i)
+    instance = damage_typeInstance(h)
-             damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1
+    outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
-            damage_nonlocal_sizePostResult(i,damage_typeInstance(h)) = 1
+    allocate(prm%outputID(0))
-       prm%outputID = [prm%outputID , damage_ID]
+    
-          end select
+    do i=1, size(outputs)
-     
+      outputID = undefined_ID
-   enddo
+      select case(outputs(i))
+      
+            case ('damage')
+            damage_nonlocal_output(i,damage_typeInstance(h)) = outputs(i)
+              damage_nonlocal_Noutput(instance) = damage_nonlocal_Noutput(instance) + 1
+             damage_nonlocal_sizePostResult(i,damage_typeInstance(h)) = 1
+        prm%outputID = [prm%outputID , damage_ID]
+           end select
+      
+    enddo
 
-   homog = h
+    homog = h
 
-     NofMyHomog = count(material_homogenizationAt == homog)
+      NofMyHomog = count(material_homogenizationAt == homog)
-     instance = damage_typeInstance(homog)
+      instance = damage_typeInstance(homog)
 
 
-! allocate state arrays
+!  allocate state arrays
-     sizeState = 1_pInt
+      sizeState = 1
-     damageState(homog)%sizeState = sizeState
+      damageState(homog)%sizeState = sizeState
-     damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance))
+      damageState(homog)%sizePostResults = sum(damage_nonlocal_sizePostResult(:,instance))
-     allocate(damageState(homog)%state0   (sizeState,NofMyHomog), source=damage_initialPhi(homog))
+      allocate(damageState(homog)%state0   (sizeState,NofMyHomog), source=damage_initialPhi(homog))
-     allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog))
+      allocate(damageState(homog)%subState0(sizeState,NofMyHomog), source=damage_initialPhi(homog))
-     allocate(damageState(homog)%state    (sizeState,NofMyHomog), source=damage_initialPhi(homog))
+      allocate(damageState(homog)%state    (sizeState,NofMyHomog), source=damage_initialPhi(homog))
 
-     nullify(damageMapping(homog)%p)
+      nullify(damageMapping(homog)%p)
-     damageMapping(homog)%p => mappingHomogenization(1,:,:)
+      damageMapping(homog)%p => mappingHomogenization(1,:,:)
-     deallocate(damage(homog)%p)
+      deallocate(damage(homog)%p)
-     damage(homog)%p => damageState(homog)%state(1,:)
+      damage(homog)%p => damageState(homog)%state(1,:)
-     
+      
-   end associate
+    end associate
- enddo
+  enddo
 end subroutine damage_nonlocal_init
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief  calculates homogenized damage driving forces  
 !--------------------------------------------------------------------------------------------------
 subroutine damage_nonlocal_getSourceAndItsTangent(phiDot, dPhiDot_dPhi, phi, ip, el)
- use material, only: &
-   homogenization_Ngrains, &
-   material_homogenizationAt, &
-   phaseAt, &
-   phasememberAt, &
-   phase_source, &
-   phase_Nsources, &
-   SOURCE_damage_isoBrittle_ID, &
-   SOURCE_damage_isoDuctile_ID, &
-   SOURCE_damage_anisoBrittle_ID, &
-   SOURCE_damage_anisoDuctile_ID
- use source_damage_isoBrittle, only: &
-   source_damage_isobrittle_getRateAndItsTangent
- use source_damage_isoDuctile, only: &
-   source_damage_isoductile_getRateAndItsTangent
- use source_damage_anisoBrittle, only: &
-   source_damage_anisobrittle_getRateAndItsTangent
- use source_damage_anisoDuctile, only: &
-   source_damage_anisoductile_getRateAndItsTangent
  
- implicit none
+  integer, intent(in) :: &
- integer(pInt), intent(in) :: &
+    ip, &                                                                                           !< integration point number
-   ip, &                                                                                            !< integration point number
+    el                                                                                              !< element number
-   el                                                                                               !< element number
+  real(pReal),   intent(in) :: &
- real(pReal),   intent(in) :: &
+    phi
-   phi
+  integer :: &
- integer(pInt) :: &
+    phase, &
-   phase, &
+    grain, &
-   grain, &
+    source, &
-   source, &
+    constituent
-   constituent
+  real(pReal) :: &
- real(pReal) :: &
+    phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi  
-   phiDot, dPhiDot_dPhi, localphiDot, dLocalphiDot_dPhi  
 
- phiDot = 0.0_pReal
+  phiDot = 0.0_pReal
- dPhiDot_dPhi = 0.0_pReal
+  dPhiDot_dPhi = 0.0_pReal
- do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
+  do grain = 1, homogenization_Ngrains(material_homogenizationAt(el))
-   phase = phaseAt(grain,ip,el)
+    phase = phaseAt(grain,ip,el)
-   constituent = phasememberAt(grain,ip,el)
+    constituent = phasememberAt(grain,ip,el)
-   do source = 1, phase_Nsources(phase)
+    do source = 1, phase_Nsources(phase)
-     select case(phase_source(source,phase))                                                   
+      select case(phase_source(source,phase))                                                   
-       case (SOURCE_damage_isoBrittle_ID)
+        case (SOURCE_damage_isoBrittle_ID)
-        call source_damage_isobrittle_getRateAndItsTangent  (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
+         call source_damage_isobrittle_getRateAndItsTangent  (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
 
-       case (SOURCE_damage_isoDuctile_ID)
+        case (SOURCE_damage_isoDuctile_ID)
-        call source_damage_isoductile_getRateAndItsTangent  (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
+         call source_damage_isoductile_getRateAndItsTangent  (localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
 
-       case (SOURCE_damage_anisoBrittle_ID)
+        case (SOURCE_damage_anisoBrittle_ID)
-        call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
+         call source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
 
-       case (SOURCE_damage_anisoDuctile_ID)
+        case (SOURCE_damage_anisoDuctile_ID)
-        call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
+         call source_damage_anisoductile_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
 
-       case default
+        case default
-        localphiDot = 0.0_pReal
+         localphiDot = 0.0_pReal
-        dLocalphiDot_dPhi = 0.0_pReal
+         dLocalphiDot_dPhi = 0.0_pReal
 
-     end select
+      end select
-     phiDot = phiDot + localphiDot
+      phiDot = phiDot + localphiDot
-     dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi
+      dPhiDot_dPhi = dPhiDot_dPhi + dLocalphiDot_dPhi
-   enddo  
+    enddo  
- enddo
+  enddo
- 
+  
- phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
+  phiDot = phiDot/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
- dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
+  dPhiDot_dPhi = dPhiDot_dPhi/real(homogenization_Ngrains(material_homogenizationAt(el)),pReal)
  
 end subroutine damage_nonlocal_getSourceAndItsTangent
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief returns homogenized non local damage diffusion tensor in reference configuration
 !--------------------------------------------------------------------------------------------------
 function damage_nonlocal_getDiffusion33(ip,el)
- use numerics, only: &
-   charLength
- use lattice, only: &
-   lattice_DamageDiffusion33
- use material, only: &
-   homogenization_Ngrains, &
-   material_phase, &
-   material_homogenizationAt
- use crystallite, only: &
-   crystallite_push33ToRef
 
- implicit none
+  integer, intent(in) :: &
- integer(pInt), intent(in) :: &
+    ip, &                                                                                           !< integration point number
-   ip, &                                                                                            !< integration point number
+    el                                                                                              !< element number
-   el                                                                                               !< element number
+  real(pReal), dimension(3,3) :: &
- real(pReal), dimension(3,3) :: &
+    damage_nonlocal_getDiffusion33
-   damage_nonlocal_getDiffusion33
+  integer :: &
- integer(pInt) :: &
+    homog, &
-   homog, &
+    grain
-   grain
+    
-   
+  homog  = material_homogenizationAt(el)
- homog  = material_homogenizationAt(el)
+  damage_nonlocal_getDiffusion33 = 0.0_pReal  
- damage_nonlocal_getDiffusion33 = 0.0_pReal  
+  do grain = 1, homogenization_Ngrains(homog)
- do grain = 1, homogenization_Ngrains(homog)
+    damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + &
-   damage_nonlocal_getDiffusion33 = damage_nonlocal_getDiffusion33 + &
+      crystallite_push33ToRef(grain,ip,el,lattice_DamageDiffusion33(1:3,1:3,material_phase(grain,ip,el)))
-     crystallite_push33ToRef(grain,ip,el,lattice_DamageDiffusion33(1:3,1:3,material_phase(grain,ip,el)))
+  enddo
- enddo
 
- damage_nonlocal_getDiffusion33 = &
+  damage_nonlocal_getDiffusion33 = &
-   charLength**2_pInt*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal)
+    charLength**2*damage_nonlocal_getDiffusion33/real(homogenization_Ngrains(homog),pReal)
  
 end function damage_nonlocal_getDiffusion33
  
+ 
 !--------------------------------------------------------------------------------------------------
 !> @brief Returns homogenized nonlocal damage mobility 
 !--------------------------------------------------------------------------------------------------
 real(pReal) function damage_nonlocal_getMobility(ip,el)
- use mesh, only: &
-   mesh_element
- use lattice, only: &
-   lattice_damageMobility
- use material, only: &
-   material_phase, &
-   homogenization_Ngrains
 
- implicit none
+  integer, intent(in) :: &
- integer(pInt), intent(in) :: &
+    ip, &                                                                                           !< integration point number
-   ip, &                                                                                            !< integration point number
+    el                                                                                              !< element number
-   el                                                                                               !< element number
+  integer :: &
- integer(pInt) :: &
+    ipc
-   ipc
+  
- 
+  damage_nonlocal_getMobility = 0.0_pReal
- damage_nonlocal_getMobility = 0.0_pReal
+                                                 
-                                                
+  do ipc = 1, homogenization_Ngrains(mesh_element(3,el))
- do ipc = 1, homogenization_Ngrains(mesh_element(3,el))
+    damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el))
-   damage_nonlocal_getMobility = damage_nonlocal_getMobility + lattice_DamageMobility(material_phase(ipc,ip,el))
+  enddo
- enddo
 
- damage_nonlocal_getMobility = damage_nonlocal_getMobility/&
+  damage_nonlocal_getMobility = damage_nonlocal_getMobility/&
-                               real(homogenization_Ngrains(mesh_element(3,el)),pReal)
+                                real(homogenization_Ngrains(mesh_element(3,el)),pReal)
 
 end function damage_nonlocal_getMobility
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief updated nonlocal damage field with solution from damage phase field PDE
 !--------------------------------------------------------------------------------------------------
 subroutine damage_nonlocal_putNonLocalDamage(phi,ip,el)
- use material, only: &
-   material_homogenizationAt, &
-   damageMapping, &
-   damage
 
- implicit none
+  integer, intent(in) :: &
- integer(pInt), intent(in) :: &
+    ip, &                                                                                           !< integration point number
-   ip, &                                                                                            !< integration point number
+    el                                                                                              !< element number
-   el                                                                                               !< element number
+  real(pReal),   intent(in) :: &
- real(pReal),   intent(in) :: &
+    phi
-   phi
+  integer :: &
- integer(pInt) :: &
+    homog, &
-   homog, &
+    offset
-   offset
+  
- 
+  homog  = material_homogenizationAt(el)
- homog  = material_homogenizationAt(el)
+  offset = damageMapping(homog)%p(ip,el)
- offset = damageMapping(homog)%p(ip,el)
+  damage(homog)%p(offset) = phi
- damage(homog)%p(offset) = phi
 
 end subroutine damage_nonlocal_putNonLocalDamage
- 
+
+
 !--------------------------------------------------------------------------------------------------
 !> @brief return array of damage results
 !--------------------------------------------------------------------------------------------------
 function damage_nonlocal_postResults(ip,el)
- use material, only: &
-   material_homogenizationAt, &
-   damage_typeInstance, &
-   damageMapping, &
-   damage
 
- implicit none
+  integer,              intent(in) :: &
- integer(pInt),              intent(in) :: &
+    ip, &                                                                                           !< integration point
-   ip, &                                                                                            !< integration point
+    el                                                                                              !< element
-   el                                                                                               !< element
+  real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
- real(pReal), dimension(sum(damage_nonlocal_sizePostResult(:,damage_typeInstance(material_homogenizationAt(el))))) :: &
+    damage_nonlocal_postResults
-   damage_nonlocal_postResults
 
- integer(pInt) :: &
+  integer :: &
-   instance, homog, offset, o, c
+    instance, homog, offset, o, c
-   
+    
- homog     = material_homogenizationAt(el)
+  homog     = material_homogenizationAt(el)
- offset    = damageMapping(homog)%p(ip,el)
+  offset    = damageMapping(homog)%p(ip,el)
- instance  = damage_typeInstance(homog)
+  instance  = damage_typeInstance(homog)
- associate(prm => param(instance))
+  associate(prm => param(instance))
- c = 0_pInt
+  c = 0
 
- outputsLoop: do o = 1_pInt,size(prm%outputID)
+  outputsLoop: do o = 1,size(prm%outputID)
-   select case(prm%outputID(o))
+    select case(prm%outputID(o))
- 
+  
-      case (damage_ID)
+       case (damage_ID)
-        damage_nonlocal_postResults(c+1_pInt) = damage(homog)%p(offset)
+         damage_nonlocal_postResults(c+1) = damage(homog)%p(offset)
-        c = c + 1
+         c = c + 1
-    end select
+     end select
- enddo outputsLoop
+  enddo outputsLoop
 
- end associate
+  end associate
 end function damage_nonlocal_postResults
 
 end module damage_nonlocal

src/debug.f90

@@ -6,12 +6,12 @@
 !> @brief Reading in and interpretating the debugging settings for the various modules
 !--------------------------------------------------------------------------------------------------
 module debug
- use prec, only: &
+ use prec
-   pInt, &
+ use IO
-   pReal
 
  implicit none
  private
+
  integer(pInt), parameter, public :: &
    debug_LEVELSELECTIVE     = 2_pInt**0_pInt, &
    debug_LEVELBASIC         = 2_pInt**1_pInt, &
@@ -78,19 +78,7 @@ contains
 !> @brief reads in parameters from debug.config and allocates arrays
 !--------------------------------------------------------------------------------------------------
 subroutine debug_init
- use prec, only: &
-   pStringLen
- use IO, only: &
-   IO_read_ASCII, &
-   IO_error, &
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_lc, &
-   IO_floatValue, &
-   IO_intValue
 
- implicit none
  character(len=pStringLen), dimension(:), allocatable :: fileContent
 
  integer                            :: i, what, j
@@ -253,8 +241,6 @@ end subroutine debug_init
 !--------------------------------------------------------------------------------------------------
 subroutine debug_reset
 
- implicit none
-
  debug_stressMaxLocation                   = 0_pInt
  debug_stressMinLocation                   = 0_pInt
  debug_jacobianMaxLocation                 = 0_pInt
@@ -272,8 +258,6 @@ end subroutine debug_reset
 !--------------------------------------------------------------------------------------------------
 subroutine debug_info
 
- implicit none
- 
  !$OMP CRITICAL (write2out)
    debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 &
                       .and. any(debug_stressMinLocation /= 0_pInt) &

src/element.f90

@@ -3,8 +3,7 @@
 !> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH
 !--------------------------------------------------------------------------------------------------
 module element
-  use prec, only: &
+  use prec
-    pReal
  
   implicit none
   private 
@@ -802,7 +801,6 @@ module element
    use IO, only: &
      IO_error
 
-   implicit none
    class(tElement) :: self
    integer, intent(in) :: elemType
    self%elemType = elemType

src/grid/DAMASK_grid.f90

@@ -9,69 +9,19 @@
 program DAMASK_spectral
 #include <petsc/finclude/petscsys.h>
  use PETScsys
- use prec, only: &
+ use prec
-   pInt, &
+ use DAMASK_interface
-   pLongInt, &
+ use IO
-   pReal, &
+ use config
-   tol_math_check, &
+ use debug
-   dNeq
+ use math
- use DAMASK_interface, only: &
+ use mesh
-   DAMASK_interface_init, &
+ use CPFEM2
-   loadCaseFile, &
+ use FEsolving
-   geometryFile, &
+ use numerics
-   getSolverJobName, &
+ use homogenization
-   interface_restartInc
+ use material
- use IO, only: &
+ use spectral_utilities
-   IO_isBlank, &
-   IO_stringPos, &
-   IO_stringValue, &
-   IO_floatValue, &
-   IO_intValue, &
-   IO_error, &
-   IO_lc, &
-   IO_intOut, &
-   IO_warning
- use config, only: &
-   config_numerics
- use debug, only: &
-   debug_level, &
-   debug_spectral, &
-   debug_levelBasic
- use math                                                                                           ! need to include the whole module for FFTW
- use mesh, only: &
-   grid, &
-   geomSize
- use CPFEM2, only: &
-   CPFEM_initAll, &
-   CPFEM_results
- use FEsolving, only: &
-   restartWrite, &
-   restartInc
- use numerics, only: &
-   worldrank, &
-   worldsize, &
-   stagItMax, &
-   maxCutBack, &
-   continueCalculation
- use homogenization, only: &
-   materialpoint_sizeResults, &
-   materialpoint_results, &
-   materialpoint_postResults
- use material, only: &
-   thermal_type, &
-   damage_type, &
-   THERMAL_conduction_ID, &
-   DAMAGE_nonlocal_ID
- use spectral_utilities, only: &
-   utilities_init, &
-   tSolutionState, &
-   tLoadCase, &
-   cutBack, &
-   nActiveFields, &
-   FIELD_UNDEFINED_ID, &
-   FIELD_MECH_ID, &
-   FIELD_THERMAL_ID, &
-   FIELD_DAMAGE_ID
  use grid_mech_spectral_basic
  use grid_mech_spectral_polarisation
  use grid_mech_FEM
@@ -86,11 +36,11 @@ program DAMASK_spectral
 ! variables related to information from load case and geom file
  real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal                                          !< temporarily from loadcase file when reading in tensors (initialize to 0.0)
  logical,     dimension(9) :: temp_maskVector  = .false.                                            !< temporarily from loadcase file when reading in tensors
- integer(pInt), allocatable, dimension(:) :: chunkPos
+ integer, allocatable, dimension(:) :: chunkPos
- integer(pInt) :: &
+ integer :: &
-   N_t   = 0_pInt, &                                                                                !< # of time indicators found in load case file
+   N_t   = 0, &                                                                                     !< # of time indicators found in load case file
-   N_n   = 0_pInt, &                                                                                !< # of increment specifiers found in load case file
+   N_n   = 0, &                                                                                     !< # of increment specifiers found in load case file
-   N_def = 0_pInt                                                                                   !< # of rate of deformation specifiers found in load case file
+   N_def = 0                                                                                        !< # of rate of deformation specifiers found in load case file
  character(len=65536) :: &
    line
 
@@ -99,8 +49,8 @@ program DAMASK_spectral
  real(pReal), dimension(3,3), parameter :: &
    ones  = 1.0_pReal, &
    zeros = 0.0_pReal
- integer(pInt), parameter :: &
+ integer, parameter :: &
-   subStepFactor = 2_pInt                                                                           !< for each substep, divide the last time increment by 2.0
+   subStepFactor = 2                                                                                !< for each substep, divide the last time increment by 2.0
  real(pReal) :: &
    time = 0.0_pReal, &                                                                              !< elapsed time
    time0 = 0.0_pReal, &                                                                             !< begin of interval
@@ -110,21 +60,21 @@ program DAMASK_spectral
  logical :: &
    guess, &                                                                                         !< guess along former trajectory
    stagIterate
- integer(pInt) :: &
+ integer :: &
    i, j, k, l, field, &
-   errorID = 0_pInt, &
+   errorID = 0, &
-   cutBackLevel = 0_pInt, &                                                                         !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
+   cutBackLevel = 0, &                                                                              !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$
-   stepFraction = 0_pInt                                                                            !< fraction of current time interval
+   stepFraction = 0                                                                                 !< fraction of current time interval
- integer(pInt) :: &
+ integer :: &
-   currentLoadcase = 0_pInt, &                                                                      !< current load case
+   currentLoadcase = 0, &                                                                           !< current load case
    inc, &                                                                                           !< current increment in current load case
-   totalIncsCounter = 0_pInt, &                                                                     !< total # of increments
+   totalIncsCounter = 0, &                                                                          !< total # of increments
-   convergedCounter = 0_pInt, &                                                                     !< # of converged increments
+   convergedCounter = 0, &                                                                          !< # of converged increments
-   notConvergedCounter = 0_pInt, &                                                                  !< # of non-converged increments
+   notConvergedCounter = 0, &                                                                       !< # of non-converged increments
-   fileUnit = 0_pInt, &                                                                             !< file unit for reading load case and writing results
+   fileUnit = 0, &                                                                                  !< file unit for reading load case and writing results
    myStat, &
-   statUnit = 0_pInt, &                                                                             !< file unit for statistics output
+   statUnit = 0, &                                                                                  !< file unit for statistics output
-   lastRestartWritten = 0_pInt, &                                                                   !< total increment # at which last restart information was written
+   lastRestartWritten = 0, &                                                                        !< total increment # at which last restart information was written
    stagIter
  character(len=6)  :: loadcase_string
  character(len=1024) :: &
@@ -134,8 +84,8 @@ program DAMASK_spectral
  type(tSolutionState), allocatable, dimension(:) :: solres
  integer(MPI_OFFSET_KIND) :: fileOffset
  integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize
- integer(pInt), parameter :: maxByteOut = 2147483647-4096                                           !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742
+ integer, parameter :: maxByteOut = 2147483647-4096                                                !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742
- integer(pInt), parameter :: maxRealOut = maxByteOut/pReal
+ integer, parameter :: maxRealOut = maxByteOut/pReal
  integer(pLongInt), dimension(2) :: outputIndex
  PetscErrorCode :: ierr
  procedure(grid_mech_spectral_basic_init), pointer :: &
@@ -174,20 +124,20 @@ program DAMASK_spectral
 
    case ('polarisation')
      if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
-       call IO_warning(42_pInt, ext_msg='debug Divergence')
+       call IO_warning(42, ext_msg='debug Divergence')
      mech_init     => grid_mech_spectral_polarisation_init
      mech_forward  => grid_mech_spectral_polarisation_forward
      mech_solution => grid_mech_spectral_polarisation_solution
      
    case ('fem')
      if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) &
-       call IO_warning(42_pInt, ext_msg='debug Divergence')
+       call IO_warning(42, ext_msg='debug Divergence')
      mech_init     => grid_mech_FEM_init
      mech_forward  => grid_mech_FEM_forward
      mech_solution => grid_mech_FEM_solution
 
    case default
-     call IO_error(error_ID = 891_pInt, ext_msg = config_numerics%getString('spectral_solver'))
+     call IO_error(error_ID = 891, ext_msg = config_numerics%getString('spectral_solver'))
 
  end select
 
@@ -195,27 +145,27 @@ program DAMASK_spectral
 ! reading information from load case file and to sanity checks 
  allocate (loadCases(0))                                                                            ! array of load cases
  open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read')
- if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile))
+ if (myStat /= 0) call IO_error(100,el=myStat,ext_msg=trim(loadCaseFile))
  do
    read(fileUnit, '(A)', iostat=myStat) line
-   if ( myStat /= 0_pInt) exit
+   if ( myStat /= 0) exit
    if (IO_isBlank(line)) cycle                                                                      ! skip empty lines
 
-   currentLoadCase = currentLoadCase + 1_pInt
+   currentLoadCase = currentLoadCase + 1
 
    chunkPos = IO_stringPos(line)
-   do i = 1_pInt, chunkPos(1)                                                                       ! reading compulsory parameters for loadcase
+   do i = 1, chunkPos(1)                                                                            ! reading compulsory parameters for loadcase
      select case (IO_lc(IO_stringValue(line,chunkPos,i)))
        case('l','velocitygrad','velgrad','velocitygradient','fdot','dotf','f')
-         N_def = N_def + 1_pInt
+         N_def = N_def + 1
        case('t','time','delta')
-         N_t = N_t + 1_pInt
+         N_t = N_t + 1
        case('n','incs','increments','steps','logincs','logincrements','logsteps')
-         N_n = N_n + 1_pInt
+         N_n = N_n + 1
      end select
    enddo
-   if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) &                                        ! sanity check
+   if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1) &                                             ! sanity check
-     call IO_error(error_ID=837_pInt,el=currentLoadCase,ext_msg = trim(loadCaseFile))               ! error message for incomplete loadcase
+     call IO_error(error_ID=837,el=currentLoadCase,ext_msg = trim(loadCaseFile))                    ! error message for incomplete loadcase
 
    newLoadCase%stress%myType='stress'
    field = 1
@@ -229,7 +179,7 @@ program DAMASK_spectral
      newLoadCase%ID(field) = FIELD_DAMAGE_ID
    endif damageActive
 
-   readIn: do i = 1_pInt, chunkPos(1)
+   readIn: do i = 1, chunkPos(1)
      select case (IO_lc(IO_stringValue(line,chunkPos,i)))
        case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f')                      ! assign values for the deformation BC matrix
          temp_valueVector = 0.0_pReal
@@ -241,7 +191,7 @@ program DAMASK_spectral
          else
            newLoadCase%deformation%myType = 'l'
          endif
-         do j = 1_pInt, 9_pInt
+         do j = 1, 9
            temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*'                            ! true if not a *
            if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j)           ! read value where applicable
          enddo
@@ -250,7 +200,7 @@ program DAMASK_spectral
          newLoadCase%deformation%values      = math_9to33(temp_valueVector)                         ! values in 3x3 notation
        case('p','pk1','piolakirchhoff','stress', 's')
          temp_valueVector = 0.0_pReal
-         do j = 1_pInt, 9_pInt
+         do j = 1, 9
            temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*'                            ! true if not an asterisk
            if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j)           ! read value where applicable
          enddo
@@ -258,54 +208,54 @@ program DAMASK_spectral
          newLoadCase%stress%maskFloat   = merge(ones,zeros,newLoadCase%stress%maskLogical)
          newLoadCase%stress%values      = math_9to33(temp_valueVector)
        case('t','time','delta')                                                                     ! increment time
-         newLoadCase%time = IO_floatValue(line,chunkPos,i+1_pInt)
+         newLoadCase%time = IO_floatValue(line,chunkPos,i+1)
        case('n','incs','increments','steps')                                                        ! number of increments
-         newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt)
+         newLoadCase%incs = IO_intValue(line,chunkPos,i+1)
        case('logincs','logincrements','logsteps')                                                   ! number of increments (switch to log time scaling)
-         newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt)
+         newLoadCase%incs = IO_intValue(line,chunkPos,i+1)
-         newLoadCase%logscale = 1_pInt
+         newLoadCase%logscale = 1
        case('freq','frequency','outputfreq')                                                        ! frequency of result writings
-         newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt)
+         newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1)
        case('r','restart','restartwrite')                                                           ! frequency of writing restart information
          newLoadCase%restartfrequency = &
-               max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt))
+               max(0,IO_intValue(line,chunkPos,i+1))
        case('guessreset','dropguessing')
          newLoadCase%followFormerTrajectory = .false.                                               ! do not continue to predict deformation along former trajectory
        case('euler')                                                                                ! rotation of load case given in euler angles
          temp_valueVector = 0.0_pReal
-         l = 1_pInt                                                                                 ! assuming values given in degrees
+         l = 1                                                                                      ! assuming values given in degrees
-         k = 1_pInt                                                                                 ! assuming keyword indicating degree/radians present
+         k = 1                                                                                      ! assuming keyword indicating degree/radians present
-         select case (IO_lc(IO_stringValue(line,chunkPos,i+1_pInt)))
+         select case (IO_lc(IO_stringValue(line,chunkPos,i+1)))
            case('deg','degree')
            case('rad','radian')                                                                     ! don't convert from degree to radian
-             l = 0_pInt
+             l = 0
            case default
-             k = 0_pInt
+             k = 0
          end select
-         do j = 1_pInt, 3_pInt
+         do j = 1, 3
            temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j)
          enddo
-         if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad                     ! convert to rad
+         if (l == 1) temp_valueVector(1:3) = temp_valueVector(1:3) * INRAD                          ! convert to rad
          newLoadCase%rotation = math_EulerToR(temp_valueVector(1:3))                                ! convert rad Eulers to rotation matrix
        case('rotation','rot')                                                                       ! assign values for the rotation  matrix
          temp_valueVector = 0.0_pReal
-         do j = 1_pInt, 9_pInt
+         do j = 1, 9
            temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j)
          enddo
          newLoadCase%rotation = math_9to33(temp_valueVector)
      end select
    enddo readIn
 
-   newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1_pInt)              ! by default, guess from previous load case
+   newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1)                   ! by default, guess from previous load case
 
    reportAndCheck: if (worldrank == 0) then
      write (loadcase_string, '(i6)' ) currentLoadCase
      write(6,'(/,1x,a,i6)') 'load case: ', currentLoadCase
      if (.not. newLoadCase%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory'
      if (newLoadCase%deformation%myType == 'l') then
-       do j = 1_pInt, 3_pInt
+       do j = 1, 3
          if (any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .true.) .and. &
-             any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832_pInt      ! each row should be either fully or not at all defined
+             any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832           ! each row should be either fully or not at all defined
        enddo
        write(6,'(2x,a)') 'velocity gradient:'
      else if (newLoadCase%deformation%myType == 'f') then
@@ -313,7 +263,7 @@ program DAMASK_spectral
      else
        write(6,'(2x,a)') 'deformation gradient rate:'
      endif
-     do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt
+     do i = 1, 3; do j = 1, 3
        if(newLoadCase%deformation%maskLogical(i,j)) then
          write(6,'(2x,f12.7)',advance='no') newLoadCase%deformation%values(i,j)
        else
@@ -322,13 +272,13 @@ program DAMASK_spectral
        enddo; write(6,'(/)',advance='no')
      enddo
      if (any(newLoadCase%stress%maskLogical .eqv. &
-             newLoadCase%deformation%maskLogical)) errorID = 831_pInt                               ! exclusive or masking only
+             newLoadCase%deformation%maskLogical)) errorID = 831                                    ! exclusive or masking only
      if (any(newLoadCase%stress%maskLogical .and. &
              transpose(newLoadCase%stress%maskLogical) .and. &
              reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) &
-             errorID = 838_pInt                                                                     ! no rotation is allowed by stress BC
+             errorID = 838                                                                          ! no rotation is allowed by stress BC
      write(6,'(2x,a)') 'stress / GPa:'
-     do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt
+     do i = 1, 3; do j = 1, 3
        if(newLoadCase%stress%maskLogical(i,j)) then
          write(6,'(2x,f12.7)',advance='no') newLoadCase%stress%values(i,j)*1e-9_pReal
        else
@@ -340,18 +290,18 @@ program DAMASK_spectral
                 transpose(newLoadCase%rotation))-math_I3) > &
                 reshape(spread(tol_math_check,1,9),[ 3,3]))&
                 .or. abs(math_det33(newLoadCase%rotation)) > &
-                1.0_pReal + tol_math_check) errorID = 846_pInt                                      ! given rotation matrix contains strain
+                1.0_pReal + tol_math_check) errorID = 846                                           ! given rotation matrix contains strain
      if (any(dNeq(newLoadCase%rotation, math_I3))) &
        write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',&
                 transpose(newLoadCase%rotation)
-     if (newLoadCase%time < 0.0_pReal) errorID = 834_pInt                                           ! negative time increment
+     if (newLoadCase%time < 0.0_pReal) errorID = 834                                                ! negative time increment
      write(6,'(2x,a,f12.6)') 'time:       ', newLoadCase%time
-     if (newLoadCase%incs < 1_pInt)    errorID = 835_pInt                                           ! non-positive incs count
+     if (newLoadCase%incs < 1)    errorID = 835                                                     ! non-positive incs count
      write(6,'(2x,a,i5)')  'increments: ', newLoadCase%incs
-     if (newLoadCase%outputfrequency < 1_pInt)  errorID = 836_pInt                                  ! non-positive result frequency
+     if (newLoadCase%outputfrequency < 1)  errorID = 836                                            ! non-positive result frequency
      write(6,'(2x,a,i5)')  'output  frequency:  ', newLoadCase%outputfrequency
      write(6,'(2x,a,i5)')  'restart frequency:  ', newLoadCase%restartfrequency
-     if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string)             ! exit with error message
+     if (errorID > 0) call IO_error(error_ID = errorID, ext_msg = loadcase_string)                  ! exit with error message
    endif reportAndCheck
    loadCases = [loadCases,newLoadCase]                                                              ! load case is ok, append it
  enddo
@@ -383,7 +333,7 @@ program DAMASK_spectral
 !--------------------------------------------------------------------------------------------------
 ! write header of output file
  if (worldrank == 0) then
-   writeHeader: if (interface_restartInc < 1_pInt) then
+   writeHeader: if (interface_restartInc < 1) then
      open(newunit=fileUnit,file=trim(getSolverJobName())//&
                                  '.spectralOut',form='UNFORMATTED',status='REPLACE')
      write(fileUnit) 'load:',       trim(loadCaseFile)                                               ! ... and write header
@@ -417,59 +367,59 @@ program DAMASK_spectral
  allocate(outputSize(worldsize), source = 0_MPI_OFFSET_KIND)
  outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND)
  call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr)       ! get total output size over each process
- if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce')
+ if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_allreduce')
  call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', &
                     MPI_MODE_WRONLY + MPI_MODE_APPEND, &
                     MPI_INFO_NULL, &
                     fileUnit, &
                     ierr)
- if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_open')
+ if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_open')
- call MPI_file_get_position(fileUnit,fileOffset,ierr)                                                ! get offset from header
+ call MPI_file_get_position(fileUnit,fileOffset,ierr)                                               ! get offset from header
- if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_get_position')
+ if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_get_position')
  fileOffset = fileOffset + sum(outputSize(1:worldrank))                                             ! offset of my process in file (header + processes before me)
  call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr)
- if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek')
+ if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_seek')
 
- writeUndeformed: if (interface_restartInc < 1_pInt) then
+ writeUndeformed: if (interface_restartInc < 1) then
    write(6,'(1/,a)') ' ... writing initial configuration to file ........................'
-   call CPFEM_results(0_pInt,0.0_pReal)
+   call CPFEM_results(0,0.0_pReal)
    do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1         ! slice the output of my process in chunks not exceeding the limit for one output
-     outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, &               ! QUESTION: why not starting i at 0 instead of murky 1?
+     outputIndex = int([(i-1)*((maxRealOut)/materialpoint_sizeResults)+1, &
                              min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
      call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), &
                                  [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
                          int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), &
                          MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
-     if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write')
+     if (ierr /= 0) call IO_error(error_ID=894, ext_msg='MPI_file_write')
    enddo
    fileOffset = fileOffset + sum(outputSize)                                                        ! forward to current file position
  endif writeUndeformed
 
 
- loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases)
+ loadCaseLooping: do currentLoadCase = 1, size(loadCases)
    time0 = time                                                                                     ! load case start time
    guess = loadCases(currentLoadCase)%followFormerTrajectory                                        ! change of load case? homogeneous guess for the first inc
 
-   incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs
+   incLooping: do inc = 1, loadCases(currentLoadCase)%incs
-     totalIncsCounter = totalIncsCounter + 1_pInt
+     totalIncsCounter = totalIncsCounter + 1
 
 !--------------------------------------------------------------------------------------------------
 ! forwarding time
      timeIncOld = timeinc                                                                           ! last timeinc that brought former inc to an end
-     if (loadCases(currentLoadCase)%logscale == 0_pInt) then                                        ! linear scale
+     if (loadCases(currentLoadCase)%logscale == 0) then                                             ! linear scale
        timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal)
      else
-       if (currentLoadCase == 1_pInt) then                                                          ! 1st load case of logarithmic scale
+       if (currentLoadCase == 1) then                                                               ! 1st load case of logarithmic scale
-         if (inc == 1_pInt) then                                                                    ! 1st inc of 1st load case of logarithmic scale
+         if (inc == 1) then                                                                         ! 1st inc of 1st load case of logarithmic scale
-           timeinc = loadCases(1)%time*(2.0_pReal**real(    1_pInt-loadCases(1)%incs ,pReal))       ! assume 1st inc is equal to 2nd
+           timeinc = loadCases(1)%time*(2.0_pReal**real(    1-loadCases(1)%incs ,pReal))            ! assume 1st inc is equal to 2nd
          else                                                                                       ! not-1st inc of 1st load case of logarithmic scale
-           timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal))
+           timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1-loadCases(1)%incs ,pReal))
          endif
        else                                                                                         ! not-1st load case of logarithmic scale
          timeinc = time0 * &
               ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc         ,pReal)/&
                                                     real(loadCases(currentLoadCase)%incs ,pReal))&
-               -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1_pInt  ,pReal)/&
+               -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc-1  ,pReal)/&
                                                     real(loadCases(currentLoadCase)%incs ,pReal)))
        endif
      endif
@@ -479,12 +429,12 @@ program DAMASK_spectral
        time = time + timeinc                                                                        ! just advance time, skip already performed calculation
        guess = .true.                                                                               ! QUESTION:why forced guessing instead of inheriting loadcase preference
      else skipping
-       stepFraction = 0_pInt                                                                        ! fraction scaled by stepFactor**cutLevel
+       stepFraction = 0                                                                             ! fraction scaled by stepFactor**cutLevel
 
        subStepLooping: do while (stepFraction < subStepFactor**cutBackLevel)
          remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time
          time = time + timeinc                                                                      ! forward target time
-         stepFraction = stepFraction + 1_pInt                                                       ! count step
+         stepFraction = stepFraction + 1                                                            ! count step
 
 !--------------------------------------------------------------------------------------------------
 ! report begin of new step
@@ -524,7 +474,7 @@ program DAMASK_spectral
 
 !--------------------------------------------------------------------------------------------------
 ! solve fields
-         stagIter = 0_pInt
+         stagIter = 0
          stagIterate = .true.
          do while (stagIterate)
            do field = 1, nActiveFields
@@ -546,7 +496,7 @@ program DAMASK_spectral
              if (.not. solres(field)%converged) exit                                                ! no solution found
 
            enddo
-           stagIter = stagIter + 1_pInt
+           stagIter = stagIter + 1
            stagIterate =            stagIter < stagItMax &
                         .and.       all(solres(:)%converged) &
                         .and. .not. all(solres(:)%stagConverged)                                    ! stationary with respect to staggered iteration
@@ -567,52 +517,52 @@ program DAMASK_spectral
            endif
          elseif (cutBackLevel < maxCutBack) then                                                    ! further cutbacking tolerated?
            cutBack = .true.
-           stepFraction = (stepFraction - 1_pInt) * subStepFactor                                   ! adjust to new denominator
+           stepFraction = (stepFraction - 1) * subStepFactor                                        ! adjust to new denominator
-           cutBackLevel = cutBackLevel + 1_pInt
+           cutBackLevel = cutBackLevel + 1
            time    = time - timeinc                                                                 ! rewind time
            timeinc = timeinc/real(subStepFactor,pReal)                                              ! cut timestep
            write(6,'(/,a)') ' cutting back '
          else                                                                                       ! no more options to continue
-           call IO_warning(850_pInt)
+           call IO_warning(850)
            call MPI_file_close(fileUnit,ierr)
            close(statUnit)
-           call quit(-1_pInt*(lastRestartWritten+1_pInt))                                           ! quit and provide information about last restart inc written
+           call quit(-1*(lastRestartWritten+1))                                                     ! quit and provide information about last restart inc written
          endif
 
        enddo subStepLooping
 
-       cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt)                                            ! try half number of subincs next inc
+       cutBackLevel = max(0, cutBackLevel - 1)                                                      ! try half number of subincs next inc
 
        if (all(solres(:)%converged)) then
-         convergedCounter = convergedCounter + 1_pInt
+         convergedCounter = convergedCounter + 1
          write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') &                                     ! report converged inc
                                    ' increment ', totalIncsCounter, ' converged'
        else
-         notConvergedCounter = notConvergedCounter + 1_pInt
+         notConvergedCounter = notConvergedCounter + 1
          write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') &                                     ! report non-converged inc
                                    ' increment ', totalIncsCounter, ' NOT converged'
        endif; flush(6)
 
-       if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then                      ! at output frequency
+       if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0) then                           ! at output frequency
          write(6,'(1/,a)') ' ... writing results to file ......................................'
          flush(6)
          call materialpoint_postResults()
          call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr)
-         if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek')
+         if (ierr /= 0) call IO_error(894, ext_msg='MPI_file_seek')
          do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1     ! slice the output of my process in chunks not exceeding the limit for one output
-           outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, &
+           outputIndex=int([(i-1)*((maxRealOut)/materialpoint_sizeResults)+1, &
                       min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt)
            call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),&
                                        [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), &
                                int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),&
                                MPI_DOUBLE, MPI_STATUS_IGNORE, ierr)
-           if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write')
+           if(ierr /=0) call IO_error(894, ext_msg='MPI_file_write')
          enddo
          fileOffset = fileOffset + sum(outputSize)                                                  ! forward to current file position
          call CPFEM_results(totalIncsCounter,time)
        endif
-       if (              loadCases(currentLoadCase)%restartFrequency > 0_pInt &                     ! writing of restart info requested ...
+       if (              loadCases(currentLoadCase)%restartFrequency > 0 &                          ! writing of restart info requested ...
-           .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then               ! ... and at frequency of writing restart information
+           .and. mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0) then                    ! ... and at frequency of writing restart information
          restartWrite = .true.                                                                      ! set restart parameter for FEsolving
          lastRestartWritten = inc                                                                   ! QUESTION: first call to CPFEM_general will write?
        endif
@@ -636,7 +586,7 @@ program DAMASK_spectral
  call MPI_file_close(fileUnit,ierr)
  close(statUnit)
 
- if (notConvergedCounter > 0_pInt) call quit(2_pInt)                                                ! error if some are not converged
+ if (notConvergedCounter > 0) call quit(2)                                                          ! error if some are not converged
- call quit(0_pInt)                                                                                  ! no complains ;)
+ call quit(0)                                                                                       ! no complains ;)
 
 end program DAMASK_spectral

src/homogenization.f90

@@ -5,8 +5,27 @@
 !> @brief homogenization manager, organizing deformation partitioning and stress homogenization
 !--------------------------------------------------------------------------------------------------
 module homogenization
- use prec, only: &
+ use prec
-   pReal
+ use IO
+ use config
+ use debug
+ use math
+ use material
+ use numerics
+ use constitutive
+ use crystallite
+ use mesh
+ use FEsolving
+ use thermal_isothermal
+ use thermal_adiabatic
+ use thermal_conduction
+ use damage_none
+ use damage_local
+ use damage_nonlocal
+#if defined(PETSc) || defined(DAMASK_HDF5)
+ use results
+ use HDF5_utilities
+#endif
 
 !--------------------------------------------------------------------------------------------------
 ! General variables for the homogenization at a  material point
@@ -22,7 +41,6 @@ module homogenization
    materialpoint_results                                                                            !< results array of material point
  integer,                                            public, protected  :: &
    materialpoint_sizeResults, &
-   homogenization_maxSizePostResults, &
    thermal_maxSizePostResults, &
    damage_maxSizePostResults
 
@@ -47,11 +65,24 @@ module homogenization
    module subroutine mech_isostrain_init
    end subroutine mech_isostrain_init
    
+   module subroutine mech_RGC_init
+   end subroutine mech_RGC_init
+   
+   
    module subroutine mech_isostrain_partitionDeformation(F,avgF)
      real(pReal),   dimension (:,:,:), intent(out) :: F                                             !< partitioned deformation gradient
      real(pReal),   dimension (3,3),   intent(in)  :: avgF                                          !< average deformation gradient at material point
    end subroutine mech_isostrain_partitionDeformation
    
+   module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
+     real(pReal),   dimension (:,:,:), intent(out) :: F                                             !< partitioned deformation gradient
+     real(pReal),   dimension (3,3),   intent(in)  :: avgF                                          !< average deformation gradient at material point
+     integer,                          intent(in)  :: &
+       instance, &
+       of
+   end subroutine mech_RGC_partitionDeformation
+   
+   
    module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
      real(pReal),   dimension (3,3),       intent(out) :: avgP                                      !< average stress at material point
      real(pReal),   dimension (3,3,3,3),   intent(out) :: dAvgPdAvgF                                !< average stiffness at material point
@@ -60,18 +91,44 @@ module homogenization
      real(pReal),   dimension (:,:,:,:,:), intent(in)  :: dPdF                                      !< partitioned stiffnesses
      integer,                              intent(in)  :: instance 
    end subroutine mech_isostrain_averageStressAndItsTangent
+   
+   module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
+     real(pReal),   dimension (3,3),       intent(out) :: avgP                                      !< average stress at material point
+     real(pReal),   dimension (3,3,3,3),   intent(out) :: dAvgPdAvgF                                !< average stiffness at material point
+ 
+     real(pReal),   dimension (:,:,:),     intent(in)  :: P                                         !< partitioned stresses
+     real(pReal),   dimension (:,:,:,:,:), intent(in)  :: dPdF                                      !< partitioned stiffnesses
+     integer,                              intent(in)  :: instance 
+   end subroutine mech_RGC_averageStressAndItsTangent
+   
+   
+   module function mech_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
+     logical, dimension(2) :: mech_RGC_updateState
+     real(pReal), dimension(:,:,:),     intent(in)    :: & 
+       P,&                                                                                          !< partitioned stresses
+       F,&                                                                                          !< partitioned deformation gradients
+       F0                                                                                           !< partitioned initial deformation gradients
+    real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF                                           !< partitioned stiffnesses
+    real(pReal), dimension(3,3),       intent(in) :: avgF                                           !< average F
+    real(pReal),                       intent(in) :: dt                                             !< time increment
+    integer,                           intent(in) :: &
+     ip, &                                                                                          !< integration point number
+     el                                                                                             !< element number
+   end function mech_RGC_updateState
 
+
+   module subroutine mech_RGC_results(instance,group)
+     integer,          intent(in) :: instance                                                       !< homogenization instance
+     character(len=*), intent(in) :: group                                                          !< group name in HDF5 file
+   end subroutine mech_RGC_results
+  
  end interface
 
  public ::  &
    homogenization_init, &
    materialpoint_stressAndItsTangent, &
-   materialpoint_postResults
+   materialpoint_postResults, &
- private :: &
+   homogenization_results
-   partitionDeformation, &
-   updateState, &
-   averageStressAndItsTangent, &
-   postResults
 
 contains
 
@@ -80,39 +137,7 @@ contains
 !> @brief module initialization
 !--------------------------------------------------------------------------------------------------
 subroutine homogenization_init
- use math, only: &
-   math_I3
- use debug, only: &
-   debug_level, &
-   debug_homogenization, &
-   debug_levelBasic, &
-   debug_e, &
-   debug_g
- use mesh, only: &
-   theMesh, &
-   mesh_element
- use constitutive, only: &
-   constitutive_plasticity_maxSizePostResults, &
-   constitutive_source_maxSizePostResults
- use crystallite, only: &
-   crystallite_maxSizePostResults
- use config, only: &
-  config_deallocate, &
-  config_homogenization, &
-  homogenization_name
- use material
- use homogenization_mech_RGC
- use thermal_isothermal
- use thermal_adiabatic
- use thermal_conduction
- use damage_none
- use damage_local
- use damage_nonlocal
- use IO
- use numerics, only: &
-   worldrank
 
- implicit none
  integer, parameter :: FILEUNIT = 200
  integer :: e,i,p
  integer, dimension(:,:), pointer :: thisSize
@@ -121,10 +146,9 @@ subroutine homogenization_init
  character(len=32) :: outputName                                                                    !< name of output, intermediate fix until HDF5 output is ready
  logical :: valid
 
-
  if (any(homogenization_type == HOMOGENIZATION_NONE_ID))      call mech_none_init
  if (any(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID)) call mech_isostrain_init
- if (any(homogenization_type == HOMOGENIZATION_RGC_ID))       call homogenization_RGC_init
+ if (any(homogenization_type == HOMOGENIZATION_RGC_ID))       call mech_RGC_init
 
  if (any(thermal_type == THERMAL_isothermal_ID)) call thermal_isothermal_init
  if (any(thermal_type == THERMAL_adiabatic_ID))  call thermal_adiabatic_init
@@ -136,39 +160,14 @@ subroutine homogenization_init
 
 !--------------------------------------------------------------------------------------------------
 ! write description file for homogenization output
- mainProcess2: if (worldrank == 0) then
+ mainProcess: if (worldrank == 0) then
    call IO_write_jobFile(FILEUNIT,'outputHomogenization')
    do p = 1,size(config_homogenization)
      if (any(material_homogenizationAt == p)) then
-       i = homogenization_typeInstance(p)                                                               ! which instance of this homogenization type
-       valid = .true.                                                                                   ! assume valid
-       select case(homogenization_type(p))                                                              ! split per homogenization type
-         case (HOMOGENIZATION_NONE_ID)
-           outputName = HOMOGENIZATION_NONE_label
-           thisOutput => null()
-           thisSize   => null()
-         case (HOMOGENIZATION_ISOSTRAIN_ID)
-           outputName = HOMOGENIZATION_ISOSTRAIN_label
-           thisOutput => null()
-           thisSize   => null()
-         case (HOMOGENIZATION_RGC_ID)
-           outputName = HOMOGENIZATION_RGC_label
-           thisOutput => homogenization_RGC_output
-           thisSize   => homogenization_RGC_sizePostResult
-         case default
-           valid = .false.
-       end select
        write(FILEUNIT,'(/,a,/)')  '['//trim(homogenization_name(p))//']'
-       if (valid) then
+       write(FILEUNIT,'(a)') '(type) n/a'
-         write(FILEUNIT,'(a)') '(type)'//char(9)//trim(outputName)
+       write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p)
-         write(FILEUNIT,'(a,i4)') '(ngrains)'//char(9),homogenization_Ngrains(p)
+       
-         if (homogenization_type(p) /= HOMOGENIZATION_NONE_ID .and. &
-             homogenization_type(p) /= HOMOGENIZATION_ISOSTRAIN_ID) then
-           do e = 1,size(thisOutput(:,i))
-             write(FILEUNIT,'(a,i4)') trim(thisOutput(e,i))//char(9),thisSize(e,i)
-           enddo
-         endif
-       endif
        i = thermal_typeInstance(p)                                                                      ! which instance of this thermal type
        valid = .true.                                                                                   ! assume valid
        select case(thermal_type(p))                                                                     ! split per thermal type
@@ -198,6 +197,7 @@ subroutine homogenization_init
            enddo
          endif
        endif
+       
        i = damage_typeInstance(p)                                                                       ! which instance of this damage type
        valid = .true.                                                                                   ! assume valid
        select case(damage_type(p))                                                                      ! split per damage type
@@ -230,7 +230,7 @@ subroutine homogenization_init
      endif
    enddo
    close(FILEUNIT)
- endif mainProcess2
+ endif mainProcess
 
  call config_deallocate('material.config/homogenization')
 
@@ -238,7 +238,7 @@ subroutine homogenization_init
 ! allocate and initialize global variables
  allocate(materialpoint_dPdF(3,3,3,3,theMesh%elem%nIPs,theMesh%nElems),       source=0.0_pReal)
  allocate(materialpoint_F0(3,3,theMesh%elem%nIPs,theMesh%nElems),             source=0.0_pReal)
- materialpoint_F0 = spread(spread(math_I3,3,theMesh%elem%nIPs),4,theMesh%nElems)                          ! initialize to identity
+ materialpoint_F0 = spread(spread(math_I3,3,theMesh%elem%nIPs),4,theMesh%nElems)                    ! initialize to identity
  allocate(materialpoint_F(3,3,theMesh%elem%nIPs,theMesh%nElems),              source=0.0_pReal)
  materialpoint_F = materialpoint_F0                                                                 ! initialize to identity
  allocate(materialpoint_subF0(3,3,theMesh%elem%nIPs,theMesh%nElems),          source=0.0_pReal)
@@ -253,18 +253,15 @@ subroutine homogenization_init
 
 !--------------------------------------------------------------------------------------------------
 ! allocate and initialize global state and postresutls variables
- homogenization_maxSizePostResults = 0
  thermal_maxSizePostResults        = 0
  damage_maxSizePostResults         = 0
  do p = 1,size(config_homogenization)
-   homogenization_maxSizePostResults = max(homogenization_maxSizePostResults,homogState       (p)%sizePostResults)
    thermal_maxSizePostResults        = max(thermal_maxSizePostResults,       thermalState     (p)%sizePostResults)
    damage_maxSizePostResults         = max(damage_maxSizePostResults        ,damageState      (p)%sizePostResults)
  enddo
 
  materialpoint_sizeResults = 1 &                                                                    ! grain count
-                           + 1 + homogenization_maxSizePostResults &                                ! homogSize & homogResult
+                           + 1 + thermal_maxSizePostResults        &
-                               + thermal_maxSizePostResults        &
                                + damage_maxSizePostResults         &
                            + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults &      ! crystallite size & crystallite results
                                                         + 1 + constitutive_plasticity_maxSizePostResults &     ! constitutive size & constitutive results
@@ -274,11 +271,6 @@ subroutine homogenization_init
  write(6,'(/,a)')   ' <<<+-  homogenization init  -+>>>'
 
  if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0) then
-#ifdef TODO
-   write(6,'(a32,1x,7(i8,1x))')   'homogenization_state0:          ', shape(homogenization_state0)
-   write(6,'(a32,1x,7(i8,1x))')   'homogenization_subState0:       ', shape(homogenization_subState0)
-   write(6,'(a32,1x,7(i8,1x))')   'homogenization_state:           ', shape(homogenization_state)
-#endif
    write(6,'(a32,1x,7(i8,1x))')   'materialpoint_dPdF:             ', shape(materialpoint_dPdF)
    write(6,'(a32,1x,7(i8,1x))')   'materialpoint_F0:               ', shape(materialpoint_F0)
    write(6,'(a32,1x,7(i8,1x))')   'materialpoint_F:                ', shape(materialpoint_F)
@@ -291,7 +283,6 @@ subroutine homogenization_init
    write(6,'(a32,1x,7(i8,1x))')   'materialpoint_requested:        ', shape(materialpoint_requested)
    write(6,'(a32,1x,7(i8,1x))')   'materialpoint_converged:        ', shape(materialpoint_converged)
    write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_doneAndHappy:     ', shape(materialpoint_doneAndHappy)
-   write(6,'(a32,1x,7(i8,1x))')   'maxSizePostResults: ', homogenization_maxSizePostResults
  endif
  flush(6)
 
@@ -305,64 +296,7 @@ end subroutine homogenization_init
 !> @brief  parallelized calculation of stress and corresponding tangent at material points
 !--------------------------------------------------------------------------------------------------
 subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
- use numerics, only: &
-   subStepMinHomog, &
-   subStepSizeHomog, &
-   stepIncreaseHomog, &
-   nMPstate
- use FEsolving, only: &
-   FEsolving_execElem, &
-   FEsolving_execIP, &
-   terminallyIll
- use mesh, only: &
-   mesh_element
- use material, only: &
-   plasticState, &
-   sourceState, &
-   homogState, &
-   thermalState, &
-   damageState, &
-   phase_Nsources, &
-   material_homogenizationAt, &
-   mappingHomogenization, &
-   phaseAt, phasememberAt, &
-   homogenization_Ngrains
- use crystallite, only: &
-   crystallite_F0, &
-   crystallite_Fp0, &
-   crystallite_Fp, &
-   crystallite_Fi0, &
-   crystallite_Fi, &
-   crystallite_Lp0, &
-   crystallite_Lp, &
-   crystallite_Li0, &
-   crystallite_Li, &
-   crystallite_S0, &
-   crystallite_S, &
-   crystallite_partionedF0, &
-   crystallite_partionedF, &
-   crystallite_partionedFp0, &
-   crystallite_partionedLp0, &
-   crystallite_partionedFi0, &
-   crystallite_partionedLi0, &
-   crystallite_partionedS0, &
-   crystallite_dt, &
-   crystallite_requested, &
-   crystallite_stress, &
-   crystallite_stressTangent, &
-   crystallite_orientations
-#ifdef DEBUG
- use debug, only: &
-   debug_level, &
-   debug_homogenization, &
-   debug_levelBasic, &
-   debug_levelExtensive, &
-   debug_levelSelective, &
-   debug_e, &
-   debug_i
-#endif
 
- implicit none
  real(pReal), intent(in) :: dt                                                                      !< time increment
  logical,     intent(in) :: updateJaco                                                              !< initiating Jacobian update
  integer :: &
@@ -389,43 +323,46 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
 ! initialize restoration points of ...
  do e = FEsolving_execElem(1),FEsolving_execElem(2)
    myNgrains = homogenization_Ngrains(mesh_element(3,e))
-   do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e); do g = 1,myNgrains
+   do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e);
+     do g = 1,myNgrains
+
+       plasticState    (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = &
+       plasticState    (phaseAt(g,i,e))%state0(         :,phasememberAt(g,i,e))
+       do mySource = 1, phase_Nsources(phaseAt(g,i,e))
+         sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = &
+         sourceState(phaseAt(g,i,e))%p(mySource)%state0(         :,phasememberAt(g,i,e))
+       enddo
+
+       crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e)
+       crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e)
+       crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e)
+       crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e)
+       crystallite_partionedF0(1:3,1:3,g,i,e)  = crystallite_F0(1:3,1:3,g,i,e)
+       crystallite_partionedS0(1:3,1:3,g,i,e)  = crystallite_S0(1:3,1:3,g,i,e)
 
-     plasticState    (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = &
-     plasticState    (phaseAt(g,i,e))%state0(         :,phasememberAt(g,i,e))
-     do mySource = 1, phase_Nsources(phaseAt(g,i,e))
-       sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = &
-       sourceState(phaseAt(g,i,e))%p(mySource)%state0(         :,phasememberAt(g,i,e))
      enddo
 
-     crystallite_partionedFp0(1:3,1:3,g,i,e) = crystallite_Fp0(1:3,1:3,g,i,e)                       ! ...plastic def grads
-     crystallite_partionedLp0(1:3,1:3,g,i,e) = crystallite_Lp0(1:3,1:3,g,i,e)                       ! ...plastic velocity grads
-     crystallite_partionedFi0(1:3,1:3,g,i,e) = crystallite_Fi0(1:3,1:3,g,i,e)                       ! ...intermediate def grads
-     crystallite_partionedLi0(1:3,1:3,g,i,e) = crystallite_Li0(1:3,1:3,g,i,e)                       ! ...intermediate velocity grads
-     crystallite_partionedF0(1:3,1:3,g,i,e)  = crystallite_F0(1:3,1:3,g,i,e)                        ! ...def grads
-     crystallite_partionedS0(1:3,1:3,g,i,e)  = crystallite_S0(1:3,1:3,g,i,e)                        ! ...2nd PK stress
 
-   enddo; enddo
+     materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e)
-   forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e))
-     materialpoint_subF0(1:3,1:3,i,e) = materialpoint_F0(1:3,1:3,i,e)                               ! ...def grad
      materialpoint_subFrac(i,e) = 0.0_pReal
      materialpoint_subStep(i,e) = 1.0_pReal/subStepSizeHomog                                        ! <<added to adopt flexibility in cutback size>>
      materialpoint_converged(i,e) = .false.                                                         ! pretend failed step of twice the required size
      materialpoint_requested(i,e) = .true.                                                          ! everybody requires calculation
-   endforall
+   
-   forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
+     if (homogState(material_homogenizationAt(e))%sizeState > 0) &
-     homogState(material_homogenizationAt(e))%sizeState > 0) &
+         homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
-       homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
+         homogState(material_homogenizationAt(e))%State0(   :,mappingHomogenization(1,i,e))           ! ...internal homogenization state
-       homogState(material_homogenizationAt(e))%State0(   :,mappingHomogenization(1,i,e))           ! ...internal homogenization state
+
-   forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
+     if (thermalState(material_homogenizationAt(e))%sizeState > 0) &
-     thermalState(material_homogenizationAt(e))%sizeState > 0) &
+         thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
-       thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
+         thermalState(material_homogenizationAt(e))%State0(   :,mappingHomogenization(1,i,e))         ! ...internal thermal state
-       thermalState(material_homogenizationAt(e))%State0(   :,mappingHomogenization(1,i,e))         ! ...internal thermal state
+       
-   forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
+     if (damageState(material_homogenizationAt(e))%sizeState > 0) &
-     damageState(material_homogenizationAt(e))%sizeState > 0) &
+         damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
-       damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
+         damageState(material_homogenizationAt(e))%State0(   :,mappingHomogenization(1,i,e))          ! ...internal damage state
-       damageState(material_homogenizationAt(e))%State0(   :,mappingHomogenization(1,i,e))          ! ...internal damage state
+   enddo
  enddo
+ 
  NiterationHomog = 0
 
  cutBackLooping: do while (.not. terminallyIll .and. &
@@ -436,7 +373,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
      myNgrains = homogenization_Ngrains(mesh_element(3,e))
      IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e)
 
-       converged: if ( materialpoint_converged(i,e) ) then
+       converged: if (materialpoint_converged(i,e)) then
 #ifdef DEBUG
          if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0 &
             .and. ((e == debug_e .and. i == debug_i) &
@@ -456,50 +393,49 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
          steppingNeeded: if (materialpoint_subStep(i,e) > subStepMinHomog) then
 
            ! wind forward grain starting point of...
-           crystallite_partionedF0(1:3,1:3,1:myNgrains,i,e) =  &
+           crystallite_partionedF0  (1:3,1:3,1:myNgrains,i,e) =  &
-              crystallite_partionedF(1:3,1:3,1:myNgrains,i,e)                                       ! ...def grads
+              crystallite_partionedF(1:3,1:3,1:myNgrains,i,e)
 
-           crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e) = &
+           crystallite_partionedFp0 (1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_Fp(1:3,1:3,1:myNgrains,i,e)                                                ! ...plastic def grads
+             crystallite_Fp         (1:3,1:3,1:myNgrains,i,e)
 
-           crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e) = &
+           crystallite_partionedLp0 (1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_Lp(1:3,1:3,1:myNgrains,i,e)                                                ! ...plastic velocity grads
+             crystallite_Lp         (1:3,1:3,1:myNgrains,i,e)
 
-           crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e) = &
+           crystallite_partionedFi0 (1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_Fi(1:3,1:3,1:myNgrains,i,e)                                                ! ...intermediate def grads
+             crystallite_Fi         (1:3,1:3,1:myNgrains,i,e)
 
-           crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e) = &
+           crystallite_partionedLi0 (1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_Li(1:3,1:3,1:myNgrains,i,e)                                                ! ...intermediate velocity grads
+             crystallite_Li         (1:3,1:3,1:myNgrains,i,e)
 
-           crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e) = &
+           crystallite_partionedS0  (1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_S(1:3,1:3,1:myNgrains,i,e)                                                 ! ...2nd PK stress
+             crystallite_S          (1:3,1:3,1:myNgrains,i,e)
 
            do g = 1,myNgrains
              plasticState    (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e)) = &
-             plasticState    (phaseAt(g,i,e))%state(          :,phasememberAt(g,i,e))
+             plasticState    (phaseAt(g,i,e))%state          (:,phasememberAt(g,i,e))
              do mySource = 1, phase_Nsources(phaseAt(g,i,e))
                sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e)) = &
-               sourceState(phaseAt(g,i,e))%p(mySource)%state(          :,phasememberAt(g,i,e))
+               sourceState(phaseAt(g,i,e))%p(mySource)%state          (:,phasememberAt(g,i,e))
              enddo
            enddo
 
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
+           if(homogState(material_homogenizationAt(e))%sizeState > 0) &
-             homogState(material_homogenizationAt(e))%sizeState > 0) &
                homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
-               homogState(material_homogenizationAt(e))%State(    :,mappingHomogenization(1,i,e))   ! ...internal homogenization state
+               homogState(material_homogenizationAt(e))%State    (:,mappingHomogenization(1,i,e))
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
+           if(thermalState(material_homogenizationAt(e))%sizeState > 0) &
-             thermalState(material_homogenizationAt(e))%sizeState > 0) &
                thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
-               thermalState(material_homogenizationAt(e))%State(    :,mappingHomogenization(1,i,e)) ! ...internal thermal state
+               thermalState(material_homogenizationAt(e))%State    (:,mappingHomogenization(1,i,e))
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
+           if(damageState(material_homogenizationAt(e))%sizeState > 0) &
-             damageState(material_homogenizationAt(e))%sizeState > 0) &
                damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) = &
-               damageState(material_homogenizationAt(e))%State(    :,mappingHomogenization(1,i,e))  ! ...internal damage state
+               damageState(material_homogenizationAt(e))%State    (:,mappingHomogenization(1,i,e))
-           materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e)                       ! ...def grad
+               
+           materialpoint_subF0(1:3,1:3,i,e) = materialpoint_subF(1:3,1:3,i,e)
+
          endif steppingNeeded
 
        else converged
-         if ( (myNgrains == 1 .and. materialpoint_subStep(i,e) <= 1.0 ) .or. &                 ! single grain already tried internal subStepping in crystallite
+         if ( (myNgrains == 1 .and. materialpoint_subStep(i,e) <= 1.0 ) .or. &                      ! single grain already tried internal subStepping in crystallite
               subStepSizeHomog * materialpoint_subStep(i,e) <=  subStepMinHomog ) then              ! would require too small subStep
                                                                                                     ! cutback makes no sense
            !$OMP FLUSH(terminallyIll)
@@ -526,16 +462,18 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
 
 !--------------------------------------------------------------------------------------------------
 ! restore...
+           if (materialpoint_subStep(i,e) < 1.0_pReal) then                                         ! protect against fake cutback from \Delta t = 2 to 1. Maybe that "trick" is not necessary anymore at all? I.e. start with \Delta t = 1
+             crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = &
+               crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e)
+             crystallite_Li(1:3,1:3,1:myNgrains,i,e) = &
+               crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e)
+           endif                                                                                    ! maybe protecting everything from overwriting (not only L) makes even more sense
            crystallite_Fp(1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e)                                      ! ...plastic def grads
+             crystallite_partionedFp0(1:3,1:3,1:myNgrains,i,e)
-           crystallite_Lp(1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_partionedLp0(1:3,1:3,1:myNgrains,i,e)                                      ! ...plastic velocity grads
            crystallite_Fi(1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e)                                      ! ...intermediate def grads
+             crystallite_partionedFi0(1:3,1:3,1:myNgrains,i,e)
-           crystallite_Li(1:3,1:3,1:myNgrains,i,e) = &
-             crystallite_partionedLi0(1:3,1:3,1:myNgrains,i,e)                                      ! ...intermediate velocity grads
            crystallite_S(1:3,1:3,1:myNgrains,i,e) = &
-              crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e)                                      ! ...2nd PK stress
+              crystallite_partionedS0(1:3,1:3,1:myNgrains,i,e)
            do g = 1, myNgrains
              plasticState    (phaseAt(g,i,e))%state(          :,phasememberAt(g,i,e)) = &
              plasticState    (phaseAt(g,i,e))%partionedState0(:,phasememberAt(g,i,e))
@@ -544,18 +482,15 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt)
                sourceState(phaseAt(g,i,e))%p(mySource)%partionedState0(:,phasememberAt(g,i,e))
              enddo
            enddo
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
+           if(homogState(material_homogenizationAt(e))%sizeState > 0) &
-             homogState(material_homogenizationAt(e))%sizeState > 0) &
                homogState(material_homogenizationAt(e))%State(    :,mappingHomogenization(1,i,e)) = &
-               homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e))   ! ...internal homogenization state
+               homogState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e))
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
+           if(thermalState(material_homogenizationAt(e))%sizeState > 0) &
-             thermalState(material_homogenizationAt(e))%sizeState > 0) &
                thermalState(material_homogenizationAt(e))%State(    :,mappingHomogenization(1,i,e)) = &
-               thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e)) ! ...internal thermal state
+               thermalState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e))
-           forall(i = FEsolving_execIP(1,e):FEsolving_execIP(2,e), &
+           if(damageState(material_homogenizationAt(e))%sizeState > 0) &
-             damageState(material_homogenizationAt(e))%sizeState > 0) &
                damageState(material_homogenizationAt(e))%State(    :,mappingHomogenization(1,i,e)) = &
-               damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e))  ! ...internal damage state
+               damageState(material_homogenizationAt(e))%subState0(:,mappingHomogenization(1,i,e))
          endif
        endif converged
 
@@ -653,26 +588,7 @@ end subroutine materialpoint_stressAndItsTangent
 !> @brief parallelized calculation of result array at material points
 !--------------------------------------------------------------------------------------------------
 subroutine materialpoint_postResults
- use FEsolving, only: &
-   FEsolving_execElem, &
-   FEsolving_execIP
- use mesh, only: &
-   mesh_element
- use material, only: &
-   material_homogenizationAt, &
-   homogState, &
-   thermalState, &
-   damageState, &
-   plasticState, &
-   sourceState, &
-   material_phase, &
-   homogenization_Ngrains, &
-   microstructure_crystallite
- use crystallite, only: &
-   crystallite_sizePostResults, &
-   crystallite_postResults
 
- implicit none
  integer :: &
    thePos, &
    theSize, &
@@ -721,20 +637,7 @@ end subroutine materialpoint_postResults
 !> @brief  partition material point def grad onto constituents
 !--------------------------------------------------------------------------------------------------
 subroutine partitionDeformation(ip,el)
- use mesh, only: &
-   mesh_element
- use material, only: &
-   homogenization_type, &
-   homogenization_Ngrains, &
-   HOMOGENIZATION_NONE_ID, &
-   HOMOGENIZATION_ISOSTRAIN_ID, &
-   HOMOGENIZATION_RGC_ID
- use crystallite, only: &
-   crystallite_partionedF
- use homogenization_mech_RGC, only: &
-   homogenization_RGC_partitionDeformation
 
- implicit none
  integer, intent(in) :: &
    ip, &                                                                                            !< integration point
    el                                                                                               !< element number
@@ -750,7 +653,7 @@ subroutine partitionDeformation(ip,el)
                           materialpoint_subF(1:3,1:3,ip,el))
 
    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
-     call homogenization_RGC_partitionDeformation(&
+     call mech_RGC_partitionDeformation(&
                          crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
                          materialpoint_subF(1:3,1:3,ip,el),&
                          ip, &
@@ -765,29 +668,7 @@ end subroutine partitionDeformation
 !> "happy" with result
 !--------------------------------------------------------------------------------------------------
 function updateState(ip,el)
- use mesh, only: &
-   mesh_element
- use material, only: &
-   homogenization_type, &
-   thermal_type, &
-   damage_type, &
-   homogenization_Ngrains, &
-   HOMOGENIZATION_RGC_ID, &
-   THERMAL_adiabatic_ID, &
-   DAMAGE_local_ID
- use crystallite, only: &
-   crystallite_P, &
-   crystallite_dPdF, &
-   crystallite_partionedF,&
-   crystallite_partionedF0
- use homogenization_mech_RGC, only: &
-   homogenization_RGC_updateState
- use thermal_adiabatic, only: &
-   thermal_adiabatic_updateState
- use damage_local, only: &
-   damage_local_updateState
 
- implicit none
  integer, intent(in) :: &
    ip, &                                                                                            !< integration point
    el                                                                                               !< element number
@@ -798,14 +679,14 @@ function updateState(ip,el)
    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
      updateState = &
        updateState .and. &
-        homogenization_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
+        mech_RGC_updateState(crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-                                       crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
+                             crystallite_partionedF(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-                                       crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),&
+                             crystallite_partionedF0(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el),&
-                                       materialpoint_subF(1:3,1:3,ip,el),&
+                             materialpoint_subF(1:3,1:3,ip,el),&
-                                       materialpoint_subdt(ip,el), &
+                             materialpoint_subdt(ip,el), &
-                                       crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
+                             crystallite_dPdF(1:3,1:3,1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
-                                       ip, &
+                             ip, &
-                                       el)
+                             el)
  end select chosenHomogenization
 
  chosenThermal: select case (thermal_type(mesh_element(3,el)))
@@ -833,21 +714,7 @@ end function updateState
 !> @brief derive average stress and stiffness from constituent quantities
 !--------------------------------------------------------------------------------------------------
 subroutine averageStressAndItsTangent(ip,el)
- use mesh, only: &
-   mesh_element
- use material, only: &
-   homogenization_type, &
-   homogenization_typeInstance, &
-   homogenization_Ngrains, &
-   HOMOGENIZATION_NONE_ID, &
-   HOMOGENIZATION_ISOSTRAIN_ID, &
-   HOMOGENIZATION_RGC_ID
- use crystallite, only: &
-   crystallite_P,crystallite_dPdF
- use homogenization_mech_RGC, only: &
-   homogenization_RGC_averageStressAndItsTangent
 
- implicit none
  integer, intent(in) :: &
    ip, &                                                                                            !< integration point
    el                                                                                               !< element number
@@ -866,7 +733,7 @@ subroutine averageStressAndItsTangent(ip,el)
        homogenization_typeInstance(mesh_element(3,el)))
 
    case (HOMOGENIZATION_RGC_ID) chosenHomogenization
-     call homogenization_RGC_averageStressAndItsTangent(&
+     call mech_RGC_averageStressAndItsTangent(&
        materialpoint_P(1:3,1:3,ip,el), &
        materialpoint_dPdF(1:3,1:3,1:3,1:3,ip,el),&
        crystallite_P(1:3,1:3,1:homogenization_Ngrains(mesh_element(3,el)),ip,el), &
@@ -882,41 +749,7 @@ end subroutine averageStressAndItsTangent
 !> if homogenization_sizePostResults(i,e) > 0 !!
 !--------------------------------------------------------------------------------------------------
 function postResults(ip,el)
- use mesh, only: &
-   mesh_element
- use material, only: &
-   thermalMapping, &
-   thermal_typeInstance, &
-   material_homogenizationAt, &
-   homogenization_typeInstance,&
-   mappingHomogenization, &
-   homogState, &
-   thermalState, &
-   damageState, &
-   homogenization_type, &
-   thermal_type, &
-   damage_type, &
-   HOMOGENIZATION_NONE_ID, &
-   HOMOGENIZATION_ISOSTRAIN_ID, &
-   HOMOGENIZATION_RGC_ID, &
-   THERMAL_isothermal_ID, &
-   THERMAL_adiabatic_ID, &
-   THERMAL_conduction_ID, &
-   DAMAGE_none_ID, &
-   DAMAGE_local_ID, &
-   DAMAGE_nonlocal_ID
- use homogenization_mech_RGC, only: &
-   homogenization_RGC_postResults
- use thermal_adiabatic, only: &
-   thermal_adiabatic_postResults
- use thermal_conduction, only: &
-   thermal_conduction_postResults
- use damage_local, only: &
-   damage_local_postResults
- use damage_nonlocal, only: &
-   damage_nonlocal_postResults
 
- implicit none
  integer, intent(in) :: &
    ip, &                                                                                            !< integration point
    el                                                                                               !< element number
@@ -926,23 +759,12 @@ function postResults(ip,el)
    postResults
  integer :: &
    startPos, endPos ,&
-   of, instance, homog
+   homog
 
 
  postResults = 0.0_pReal
  startPos = 1
- endPos   = homogState(material_homogenizationAt(el))%sizePostResults
+ endPos   = thermalState(material_homogenizationAt(el))%sizePostResults
- chosenHomogenization: select case (homogenization_type(mesh_element(3,el)))
-
-   case (HOMOGENIZATION_RGC_ID) chosenHomogenization
-     instance = homogenization_typeInstance(material_homogenizationAt(el))
-     of = mappingHomogenization(1,ip,el)
-     postResults(startPos:endPos) = homogenization_RGC_postResults(instance,of)
-     
- end select chosenHomogenization
-
- startPos = endPos + 1
- endPos   = endPos + thermalState(material_homogenizationAt(el))%sizePostResults
  chosenThermal: select case (thermal_type(mesh_element(3,el)))
 
    case (THERMAL_adiabatic_ID) chosenThermal
@@ -969,4 +791,36 @@ function postResults(ip,el)
 
 end function postResults
 
+
+!--------------------------------------------------------------------------------------------------
+!> @brief writes homogenization results to HDF5 output file
+!--------------------------------------------------------------------------------------------------
+subroutine homogenization_results
+#if defined(PETSc) || defined(DAMASK_HDF5)
+  use config, only: &
+    config_name_homogenization => homogenization_name                                               ! anticipate logical name
+  use material, only: &
+    material_homogenization_type => homogenization_type
+    
+  integer :: p
+  character(len=256) :: group
+                                             
+  do p=1,size(config_name_homogenization)
+    group = trim('current/materialpoint')//'/'//trim(config_name_homogenization(p))
+    call HDF5_closeGroup(results_addGroup(group))
+    
+    group = trim(group)//'/mech'
+    
+    call HDF5_closeGroup(results_addGroup(group))  
+    select case(material_homogenization_type(p))
+      case(HOMOGENIZATION_rgc_ID)
+        call mech_RGC_results(homogenization_typeInstance(p),group)
+    end select
+  
+ enddo   
+#endif
+
+
+end subroutine homogenization_results
+
 end module homogenization

src/homogenization_mech_RGC.f90

@@ -6,16 +6,7 @@
 !> @brief Relaxed grain cluster (RGC) homogenization scheme
 !> Nconstituents is defined as p x q x r (cluster)
 !--------------------------------------------------------------------------------------------------
-module homogenization_mech_RGC
+submodule(homogenization) homogenization_mech_RGC
- use prec, only: &
-   pReal
-
- implicit none
- private
- integer,           dimension(:,:),     allocatable,target, public :: &
-   homogenization_RGC_sizePostResult
- character(len=64), dimension(:,:),     allocatable,target, public :: &
-   homogenization_RGC_output                                                                        ! name of each post result output
 
  enum, bind(c) 
    enumerator :: &
@@ -28,7 +19,7 @@ module homogenization_mech_RGC
      magnitudemismatch_ID
  end enum
  
- type, private :: tParameters
+ type :: tParameters
    integer, dimension(:), allocatable :: &
      Nconstituents
    real(pReal) :: &
@@ -39,11 +30,11 @@ module homogenization_mech_RGC
      angles
    integer :: &
      of_debug = 0
-   integer(kind(undefined_ID)),         dimension(:),   allocatable   :: &
+   integer(kind(undefined_ID)),  dimension(:),   allocatable   :: &
      outputID
  end type tParameters
 
- type, private :: tRGCstate
+ type :: tRGCstate
    real(pReal), pointer,     dimension(:) :: &
      work, &
      penaltyEnergy
@@ -51,7 +42,7 @@ module homogenization_mech_RGC
      relaxationVector
  end type tRGCstate
 
- type, private :: tRGCdependentState
+ type :: tRGCdependentState
    real(pReal), allocatable,     dimension(:) :: &
      volumeDiscrepancy, &
      relaxationRate_avg, &
@@ -62,68 +53,25 @@ module homogenization_mech_RGC
      orientation
  end type tRGCdependentState
 
- type(tparameters),          dimension(:), allocatable, private :: &
+ type(tparameters),          dimension(:), allocatable :: &
    param
- type(tRGCstate),            dimension(:), allocatable, private :: &
+ type(tRGCstate),            dimension(:), allocatable :: &
    state, &
    state0
- type(tRGCdependentState),   dimension(:), allocatable, private :: &
+ type(tRGCdependentState),   dimension(:), allocatable :: &
    dependentState
 
- public :: &
-   homogenization_RGC_init, &
-   homogenization_RGC_partitionDeformation, &
-   homogenization_RGC_averageStressAndItsTangent, &
-   homogenization_RGC_updateState, &
-   homogenization_RGC_postResults
- private :: &
-   relaxationVector, &
-   interfaceNormal, &
-   getInterface, &
-   grain1to3, &
-   grain3to1, &
-   interface4to1, &
-   interface1to4
-
 contains
 
 !--------------------------------------------------------------------------------------------------
 !> @brief allocates all necessary fields, reads information from material configuration file
 !--------------------------------------------------------------------------------------------------
-subroutine homogenization_RGC_init()
+module subroutine mech_RGC_init
- use debug, only: &
-#ifdef DEBUG
-   debug_i, &
-   debug_e, &
-#endif
-   debug_level, &
-   debug_homogenization, &
-   debug_levelBasic
- use math, only: &
-   math_EulerToR, &
-   INRAD
- use IO, only: &
-   IO_error
- use material, only: &
-#ifdef DEBUG
-   mappingHomogenization, &
-#endif
-   homogenization_type, &
-   material_homogenizationAt, &
-   homogState, &
-   HOMOGENIZATION_RGC_ID, &
-   HOMOGENIZATION_RGC_LABEL, &
-   homogenization_typeInstance, &
-   homogenization_Noutput, &
-   homogenization_Ngrains
- use config, only: &
-   config_homogenization
 
- implicit none
  integer :: &
    Ninstance, &
    h, i, &
-   NofMyHomog, outputSize, &
+   NofMyHomog, &
    sizeState, nIntFaceTot
 
  character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
@@ -151,9 +99,6 @@ subroutine homogenization_RGC_init()
  allocate(state0(Ninstance))
  allocate(dependentState(Ninstance))
  
- allocate(homogenization_RGC_sizePostResult(maxval(homogenization_Noutput),Ninstance),source=0)
- allocate(homogenization_RGC_output(maxval(homogenization_Noutput),Ninstance))
-          homogenization_RGC_output=''
 
  do h = 1, size(homogenization_type)
    if (homogenization_type(h) /= HOMOGENIZATION_RGC_ID) cycle
@@ -188,28 +133,20 @@ subroutine homogenization_RGC_init()
      
        case('constitutivework')
          outputID = constitutivework_ID
-         outputSize = 1
        case('penaltyenergy')
          outputID = penaltyenergy_ID
-         outputSize = 1
        case('volumediscrepancy')
          outputID = volumediscrepancy_ID
-         outputSize = 1
        case('averagerelaxrate')
          outputID = averagerelaxrate_ID
-         outputSize = 1
        case('maximumrelaxrate')
          outputID = maximumrelaxrate_ID
-         outputSize = 1
        case('magnitudemismatch')
          outputID = magnitudemismatch_ID
-         outputSize = 3
 
      end select
      
      if (outputID /= undefined_ID) then
-       homogenization_RGC_output(i,homogenization_typeInstance(h)) = outputs(i)
-       homogenization_RGC_sizePostResult(i,homogenization_typeInstance(h)) = outputSize
        prm%outputID = [prm%outputID , outputID]
      endif
      
@@ -223,7 +160,7 @@ subroutine homogenization_RGC_init()
              + size(['avg constitutive work ','average penalty energy'])
 
    homogState(h)%sizeState = sizeState
-   homogState(h)%sizePostResults = sum(homogenization_RGC_sizePostResult(:,homogenization_typeInstance(h)))
+   homogState(h)%sizePostResults = 0
    allocate(homogState(h)%state0   (sizeState,NofMyHomog), source=0.0_pReal)
    allocate(homogState(h)%subState0(sizeState,NofMyHomog), source=0.0_pReal)
    allocate(homogState(h)%state    (sizeState,NofMyHomog), source=0.0_pReal)
@@ -247,24 +184,17 @@ subroutine homogenization_RGC_init()
    
  enddo  
  
-end subroutine homogenization_RGC_init
+end subroutine mech_RGC_init
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief partitions the deformation gradient onto the constituents
 !--------------------------------------------------------------------------------------------------
-subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of)
+module subroutine mech_RGC_partitionDeformation(F,avgF,instance,of)
-#ifdef DEBUG
- use debug, only: &
-   debug_level, &
-   debug_homogenization, &
-   debug_levelExtensive
-#endif
 
- implicit none
  real(pReal),   dimension (:,:,:), intent(out) :: F                                                 !< partioned F  per grain
  
- real(pReal),   dimension (:,:),   intent(in)  :: avgF                                              !< averaged F
+ real(pReal),   dimension (3,3),   intent(in)  :: avgF                                              !< averaged F
  integer,                          intent(in)  :: &
    instance, &
    of
@@ -304,53 +234,14 @@ subroutine homogenization_RGC_partitionDeformation(F,avgF,instance,of)
  
  end associate
 
-end subroutine homogenization_RGC_partitionDeformation
+end subroutine mech_RGC_partitionDeformation
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief update the internal state of the homogenization scheme and tell whether "done" and 
 ! "happy" with result
 !--------------------------------------------------------------------------------------------------
-function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
+module procedure mech_RGC_updateState
- use prec, only: &
-   dEq0
-#ifdef DEBUG
- use debug, only: &
-   debug_level, &
-   debug_homogenization,&
-   debug_levelExtensive
-#endif
- use math, only: &
-   math_invert2
- use material, only: &
-   material_homogenizationAt, &
-   homogenization_typeInstance, &
-   mappingHomogenization
- use numerics, only: &
-   absTol_RGC, &
-   relTol_RGC, &
-   absMax_RGC, &
-   relMax_RGC, &
-   pPert_RGC, &
-   maxdRelax_RGC, &
-   viscPower_RGC, &
-   viscModus_RGC, &
-   refRelaxRate_RGC
-
- implicit none
-
- real(pReal), dimension(:,:,:),     intent(in)    :: & 
-   P,&                                                                                              !< array of P
-   F,&                                                                                              !< array of F
-   F0                                                                                               !< array of initial F
- real(pReal), dimension(:,:,:,:,:), intent(in) :: dPdF                                              !< array of current grain stiffness
- real(pReal), dimension(3,3),       intent(in) :: avgF                                              !< average F
- real(pReal),                       intent(in) :: dt                                                !< time increment
- integer,                           intent(in) :: &
-   ip, &                                                                                            !< integration point number
-   el                                                                                               !< element number
-
- logical, dimension(2) :: homogenization_RGC_updateState
 
  integer, dimension(4) :: intFaceN,intFaceP,faceID
  integer, dimension(3) :: nGDim,iGr3N,iGr3P
@@ -368,7 +259,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
 #endif
  
  zeroTimeStep: if(dEq0(dt)) then
-   homogenization_RGC_updateState = .true.                                                          ! pretend everything is fine and return
+   mech_RGC_updateState = .true.                                                                    ! pretend everything is fine and return
    return                                                                    
  endif zeroTimeStep
 
@@ -487,12 +378,12 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
  endif
 #endif
  
- homogenization_RGC_updateState = .false.
+ mech_RGC_updateState = .false.
  
 !--------------------------------------------------------------------------------------------------
 !  If convergence reached => done and happy
  if (residMax < relTol_RGC*stresMax .or. residMax < absTol_RGC) then 
-   homogenization_RGC_updateState = .true.
+   mech_RGC_updateState = .true.
 #ifdef DEBUG
     if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 &
         .and. prm%of_debug == of) write(6,'(1x,a55,/)')'... done and happy'
@@ -534,7 +425,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
 !--------------------------------------------------------------------------------------------------
 ! if residual blows-up => done but unhappy
  elseif (residMax > relMax_RGC*stresMax .or. residMax > absMax_RGC) then                            ! try to restart when residual blows up exceeding maximum bound
-   homogenization_RGC_updateState = [.true.,.false.]                                                ! with direct cut-back
+   mech_RGC_updateState = [.true.,.false.]                                                          ! with direct cut-back
    
 #ifdef DEBUG
    if (iand(debug_level(debug_homogenization),debug_levelExtensive) /= 0 &
@@ -677,9 +568,10 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
 !--------------------------------------------------------------------------------------------------
 ! ... of the numerical viscosity traction "rmatrix"
  allocate(rmatrix(3*nIntFaceTot,3*nIntFaceTot),source=0.0_pReal)
- forall (i=1:3*nIntFaceTot) &
+ do i=1,3*nIntFaceTot
    rmatrix(i,i) = viscModus_RGC*viscPower_RGC/(refRelaxRate_RGC*dt)* &                              ! tangent due to numerical viscosity traction appears
                   (abs(drelax(i))/(refRelaxRate_RGC*dt))**(viscPower_RGC - 1.0_pReal)               ! only in the main diagonal term 
+ enddo
                                                                         
 #ifdef DEBUG
  if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0) then
@@ -731,7 +623,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
  enddo; enddo
  stt%relaxationVector(:,of) = relax + drelax                                                        ! Updateing the state variable for the next iteration
  if (any(abs(drelax) > maxdRelax_RGC)) then                                                         ! Forcing cutback when the incremental change of relaxation vector becomes too large
-   homogenization_RGC_updateState = [.true.,.false.]
+   mech_RGC_updateState = [.true.,.false.]
    !$OMP CRITICAL (write2out)
    write(6,'(1x,a,1x,i3,1x,a,1x,i3,1x,a)')'RGC_updateState: ip',ip,'| el',el,'enforces cutback'
    write(6,'(1x,a,1x,e15.8)')'due to large relaxation change =',maxval(abs(drelax))
@@ -757,12 +649,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
  !> @brief calculate stress-like penalty due to deformation mismatch
  !--------------------------------------------------------------------------------------------------
  subroutine stressPenalty(rPen,nMis,avgF,fDef,ip,el,instance,of)
-  use math, only: &
+
-    math_civita
-  use numerics, only: &
-    xSmoo_RGC
-  
-  implicit none
   real(pReal),   dimension (:,:,:), intent(out) :: rPen                                             !< stress-like penalty
   real(pReal),   dimension (:,:),   intent(out) :: nMis                                             !< total amount of mismatch
   
@@ -874,15 +761,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
  !> @brief calculate stress-like penalty due to volume discrepancy 
  !--------------------------------------------------------------------------------------------------
  subroutine volumePenalty(vPen,vDiscrep,fAvg,fDef,nGrain,instance,of)
-  use math, only: &
-    math_det33, &
-    math_inv33
-  use numerics, only: &
-    maxVolDiscr_RGC,&
-    volDiscrMod_RGC,&
-    volDiscrPow_RGC
  
-  implicit none
   real(pReal), dimension (:,:,:), intent(out) :: vPen                                               ! stress-like penalty due to volume
   real(pReal),                    intent(out) :: vDiscrep                                           ! total volume discrepancy
   
@@ -930,10 +809,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
  ! deformation
  !--------------------------------------------------------------------------------------------------
  function surfaceCorrection(avgF,instance,of)
-  use math, only: &
-    math_invert33
   
-  implicit none
   real(pReal), dimension(3)               :: surfaceCorrection
 
   real(pReal), dimension(3,3), intent(in) :: avgF                                                    !< average F
@@ -964,10 +840,7 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
  !> @brief compute the equivalent shear and bulk moduli from the elasticity tensor
  !--------------------------------------------------------------------------------------------------
  function equivalentModuli(grainID,ip,el)
-  use constitutive, only: &
-    constitutive_homogenizedC
  
-  implicit none
   real(pReal), dimension(2)    :: equivalentModuli
 
   integer, intent(in)    :: &
@@ -1003,7 +876,6 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
  !--------------------------------------------------------------------------------------------------
  subroutine grainDeformation(F, avgF, instance, of)
   
-  implicit none
   real(pReal),   dimension(:,:,:), intent(out) :: F                                                  !< partioned F  per grain
  
   real(pReal),   dimension(:,:),   intent(in)  :: avgF                                               !< averaged F
@@ -1038,15 +910,14 @@ function homogenization_RGC_updateState(P,F,F0,avgF,dt,dPdF,ip,el)
   
  end subroutine grainDeformation
  
-end function homogenization_RGC_updateState
+end procedure mech_RGC_updateState
 
 
 !--------------------------------------------------------------------------------------------------
 !> @brief derive average stress and stiffness from constituent quantities 
 !--------------------------------------------------------------------------------------------------
-subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
+module subroutine mech_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
 
- implicit none
  real(pReal), dimension (3,3),        intent(out) :: avgP                                           !< average stress at material point
  real(pReal), dimension (3,3,3,3),    intent(out) :: dAvgPdAvgF                                     !< average stiffness at material point
 
@@ -1057,56 +928,54 @@ subroutine homogenization_RGC_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,
  avgP       = sum(P,3)   /real(product(param(instance)%Nconstituents),pReal)
  dAvgPdAvgF = sum(dPdF,5)/real(product(param(instance)%Nconstituents),pReal)
 
-end subroutine homogenization_RGC_averageStressAndItsTangent
+end subroutine mech_RGC_averageStressAndItsTangent
 
 
 !--------------------------------------------------------------------------------------------------
-!> @brief return array of homogenization results for post file inclusion 
+!> @brief writes results to HDF5 output file
+! ToDo: check wheter units are correct
 !--------------------------------------------------------------------------------------------------
-pure function homogenization_RGC_postResults(instance,of) result(postResults)
+module subroutine mech_RGC_results(instance,group)
+#if defined(PETSc) || defined(DAMASK_HDF5)
 
- implicit none
+  integer,          intent(in) :: instance
- integer, intent(in) :: &
+  character(len=*), intent(in) :: group
-   instance, &
+  
-   of
+  integer :: o
-   
+  
- integer :: &
+  associate(stt => state(instance), dst => dependentState(instance), prm => param(instance))
-   o,c
- real(pReal), dimension(sum(homogenization_RGC_sizePostResult(:,instance))) :: &
-   postResults
 
- associate(stt => state(instance), dst => dependentState(instance), prm => param(instance))
+  outputsLoop: do o = 1,size(prm%outputID)
+    select case(prm%outputID(o))
+    
+      case (constitutivework_ID)
+        call results_writeDataset(group,stt%work,'W',&
+                                  'work density','J/m³')
+      case (magnitudemismatch_ID)
+        call results_writeDataset(group,dst%mismatch,'N',&
+                                  'average mismatch tensor','1')
+      case (penaltyenergy_ID)
+        call results_writeDataset(group,stt%penaltyEnergy,'R',&
+                                  'mismatch penalty density','J/m³')
+      case (volumediscrepancy_ID)
+        call results_writeDataset(group,dst%volumeDiscrepancy,'Delta_V',&
+                                  'volume discrepancy','m³')
+      case (maximumrelaxrate_ID)
+        call results_writeDataset(group,dst%relaxationrate_max,'max_alpha_dot',&
+                                  'maximum relaxation rate','m/s')
+      case (averagerelaxrate_ID)
+        call results_writeDataset(group,dst%relaxationrate_avg,'avg_alpha_dot',&
+                                  'average relaxation rate','m/s')
+    end select
+  enddo outputsLoop
+  end associate
+  
+#else
+  integer,          intent(in) :: instance
+  character(len=*), intent(in) :: group
+#endif
 
- c = 0
+end subroutine mech_RGC_results
-
- outputsLoop: do o = 1,size(prm%outputID)
-   select case(prm%outputID(o))
-   
-     case (constitutivework_ID)
-       postResults(c+1) = stt%work(of)
-       c = c + 1
-     case (magnitudemismatch_ID)
-       postResults(c+1:c+3) = dst%mismatch(1:3,of)
-       c = c + 3
-     case (penaltyenergy_ID)
-       postResults(c+1) = stt%penaltyEnergy(of)
-       c = c + 1
-     case (volumediscrepancy_ID)
-       postResults(c+1) = dst%volumeDiscrepancy(of)
-       c = c + 1
-     case (averagerelaxrate_ID)
-       postResults(c+1) = dst%relaxationrate_avg(of)
-       c = c + 1
-     case (maximumrelaxrate_ID)
-       postResults(c+1) = dst%relaxationrate_max(of)
-       c = c + 1
-   end select
-   
- enddo outputsLoop
- 
- end associate
- 
-end function homogenization_RGC_postResults
 
 
 !--------------------------------------------------------------------------------------------------
@@ -1114,7 +983,6 @@ end function homogenization_RGC_postResults
 !--------------------------------------------------------------------------------------------------
 pure function relaxationVector(intFace,instance,of)
 
- implicit none
  real(pReal), dimension (3)            :: relaxationVector
 
  integer,                   intent(in) :: instance,of
@@ -1142,7 +1010,6 @@ end function relaxationVector
 !--------------------------------------------------------------------------------------------------
 pure function interfaceNormal(intFace,instance,of)
  
- implicit none
  real(pReal), dimension(3)             :: interfaceNormal
 
  integer,     dimension(4), intent(in) :: intFace                                                   !< interface ID in 4D array (normal and position)
@@ -1168,7 +1035,6 @@ end function interfaceNormal
 !--------------------------------------------------------------------------------------------------
 pure function getInterface(iFace,iGrain3)
 
- implicit none
  integer, dimension(4)             :: getInterface
 
  integer, dimension(3), intent(in) :: iGrain3                                                       !< grain ID in 3D array
@@ -1193,7 +1059,6 @@ end function getInterface
 !--------------------------------------------------------------------------------------------------
 pure function grain1to3(grain1,nGDim)
  
- implicit none
  integer, dimension(3)             :: grain1to3
 
  integer,               intent(in) :: grain1                                                        !< grain ID in 1D array
@@ -1211,7 +1076,6 @@ end function grain1to3
 !--------------------------------------------------------------------------------------------------
 integer pure function grain3to1(grain3,nGDim)
 
- implicit none
  integer, dimension(3), intent(in) :: grain3                                                        !< grain ID in 3D array (pos.x,pos.y,pos.z)
  integer, dimension(3), intent(in) :: nGDim
 
@@ -1227,7 +1091,6 @@ end function grain3to1
 !--------------------------------------------------------------------------------------------------
 integer pure function interface4to1(iFace4D, nGDim)
  
- implicit none
  integer, dimension(4), intent(in) :: iFace4D                                                       !< interface ID in 4D array (n.dir,pos.x,pos.y,pos.z)
  integer, dimension(3), intent(in) :: nGDim
 
@@ -1248,7 +1111,7 @@ integer pure function interface4to1(iFace4D, nGDim)
      else
        interface4to1 = iFace4D(4) + nGDim(3)*(iFace4D(2)-1) &
                      + nGDim(3)*nGDim(1)*(iFace4D(3)-1) &
-                     + (nGDim(1)-1)*nGDim(2)*nGDim(3)                                               ! total number of interfaces normal //e1
+                     + (nGDim(1)-1)*nGDim(2)*nGDim(3)                                               ! total # of interfaces normal || e1
      endif
 
    case(3)
@@ -1257,8 +1120,8 @@ integer pure function interface4to1(iFace4D, nGDim)
      else
        interface4to1 = iFace4D(2) + nGDim(1)*(iFace4D(3)-1) &
                      + nGDim(1)*nGDim(2)*(iFace4D(4)-1) &
-                     + (nGDim(1)-1)*nGDim(2)*nGDim(3) &                                             ! total number of interfaces normal //e1
+                     + (nGDim(1)-1)*nGDim(2)*nGDim(3) &                                             ! total # of interfaces normal || e1
-                     + nGDim(1)*(nGDim(2)-1)*nGDim(3)                                               ! total number of interfaces normal //e2
+                     + nGDim(1)*(nGDim(2)-1)*nGDim(3)                                               ! total # of interfaces normal || e2
      endif
 
    case default
@@ -1274,7 +1137,6 @@ end function interface4to1
 !--------------------------------------------------------------------------------------------------
 pure function interface1to4(iFace1D, nGDim)
  
- implicit none
  integer, dimension(4)             :: interface1to4
 
  integer,               intent(in) :: iFace1D                                                       !< interface ID in 1D array
@@ -1283,23 +1145,23 @@ pure function interface1to4(iFace1D, nGDim)
 
 !--------------------------------------------------------------------------------------------------
 ! compute the total number of interfaces, which ...
- nIntFace = [(nGDim(1)-1)*nGDim(2)*nGDim(3), &                                                      ! ... normal //e1
+ nIntFace = [(nGDim(1)-1)*nGDim(2)*nGDim(3), &                                                      ! ... normal || e1
-             nGDim(1)*(nGDim(2)-1)*nGDim(3), &                                                      ! ... normal //e2
+             nGDim(1)*(nGDim(2)-1)*nGDim(3), &                                                      ! ... normal || e2
-             nGDim(1)*nGDim(2)*(nGDim(3)-1)]                                                        ! ... normal //e3
+             nGDim(1)*nGDim(2)*(nGDim(3)-1)]                                                        ! ... normal || e3
 
 !--------------------------------------------------------------------------------------------------
 ! get the corresponding interface ID in 4D (normal and local position)
- if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then                                                 ! interface with normal //e1
+ if (iFace1D > 0 .and. iFace1D <= nIntFace(1)) then                                                 ! interface with normal || e1
    interface1to4(1) = 1
    interface1to4(3) = mod((iFace1D-1),nGDim(2))+1
    interface1to4(4) = mod(int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)),nGDim(3))+1
    interface1to4(2) = int(real(iFace1D-1,pReal)/real(nGDim(2),pReal)/real(nGDim(3),pReal))+1
- elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then                   ! interface with normal //e2
+ elseif (iFace1D > nIntFace(1) .and. iFace1D <= (nIntFace(2) + nIntFace(1))) then                   ! interface with normal || e2
    interface1to4(1) = 2
    interface1to4(4) = mod((iFace1D-nIntFace(1)-1),nGDim(3))+1
    interface1to4(2) = mod(int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)),nGDim(1))+1
    interface1to4(3) = int(real(iFace1D-nIntFace(1)-1,pReal)/real(nGDim(3),pReal)/real(nGDim(1),pReal))+1
- elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal //e3
+ elseif (iFace1D > nIntFace(2) + nIntFace(1) .and. iFace1D <= (nIntFace(3) + nIntFace(2) + nIntFace(1))) then ! interface with normal || e3
    interface1to4(1) = 3
    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
@@ -1309,4 +1171,4 @@ pure function interface1to4(iFace1D, nGDim)
 end function interface1to4
 
 
-end module homogenization_mech_RGC
+end submodule homogenization_mech_RGC

src/homogenization_mech_isostrain.f90

@@ -6,8 +6,6 @@
 !--------------------------------------------------------------------------------------------------
 submodule(homogenization) homogenization_mech_isostrain
 
-  implicit none
-
   enum, bind(c) 
     enumerator :: &
       parallel_ID, &
@@ -30,23 +28,7 @@ contains
 !> @brief allocates all neccessary fields, reads information from material configuration file
 !--------------------------------------------------------------------------------------------------
 module subroutine mech_isostrain_init
-  use debug, only: &
+
-    debug_HOMOGENIZATION, &
-    debug_level, &
-    debug_levelBasic
-  use IO, only: &
-    IO_error
-  use material, only: &
-    homogenization_type, &
-    material_homogenizationAt, &
-    homogState, &
-    HOMOGENIZATION_ISOSTRAIN_ID, &
-    HOMOGENIZATION_ISOSTRAIN_LABEL, &
-    homogenization_typeInstance
-  use config, only: &
-    config_homogenization
-  
-  implicit none
   integer :: &
     Ninstance, &
     h, &
@@ -98,7 +80,6 @@ end subroutine mech_isostrain_init
 !--------------------------------------------------------------------------------------------------
 module subroutine mech_isostrain_partitionDeformation(F,avgF)
   
-  implicit none
   real(pReal),   dimension (:,:,:), intent(out) :: F                                                !< partitioned deformation gradient
   
   real(pReal),   dimension (3,3),   intent(in)  :: avgF                                             !< average deformation gradient at material point
@@ -112,8 +93,7 @@ end subroutine mech_isostrain_partitionDeformation
 !> @brief derive average stress and stiffness from constituent quantities 
 !--------------------------------------------------------------------------------------------------
 module subroutine mech_isostrain_averageStressAndItsTangent(avgP,dAvgPdAvgF,P,dPdF,instance)
-  
+   
-  implicit none
   real(pReal),   dimension (3,3),       intent(out) :: avgP                                         !< average stress at material point
   real(pReal),   dimension (3,3,3,3),   intent(out) :: dAvgPdAvgF                                   !< average stiffness at material point
  

src/homogenization_mech_none.f90

@@ -6,35 +6,20 @@
 !--------------------------------------------------------------------------------------------------
 submodule(homogenization) homogenization_mech_none
 
-  implicit none
-
 contains
 
 !--------------------------------------------------------------------------------------------------
 !> @brief allocates all neccessary fields, reads information from material configuration file
 !--------------------------------------------------------------------------------------------------
 module subroutine mech_none_init
-  use debug, only: &
+
-    debug_HOMOGENIZATION, &
-    debug_level, &
-    debug_levelBasic
-  use config, only: &
-    config_homogenization
-  use material, only: &
-    homogenization_type, &
-    material_homogenizationAt, &
-    homogState, &
-    HOMOGENIZATION_NONE_LABEL, &
-    HOMOGENIZATION_NONE_ID
- 
-  implicit none
   integer :: &
     Ninstance, &
     h, &
     NofMyHomog
  
   write(6,'(/,a)')   ' <<<+-  homogenization_'//HOMOGENIZATION_NONE_label//' init  -+>>>'
- 
+
   Ninstance = count(homogenization_type == HOMOGENIZATION_NONE_ID)
   if (iand(debug_level(debug_HOMOGENIZATION),debug_levelBasic) /= 0) &
     write(6,'(a16,1x,i5,/)') '# instances:',Ninstance

src/kinematics_cleavage_opening.f90

@@ -5,46 +5,51 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module kinematics_cleavage_opening
- use prec, only: &
+  use prec
-   pReal, &
+  use IO
-   pInt
+  use config
+  use debug
+  use math
+  use lattice
+  use material
 
- implicit none
+  implicit none
- private
+  private
- integer(pInt), dimension(:), allocatable, private :: kinematics_cleavage_opening_instance
 
- type, private :: tParameters                                                                       !< container type for internal constitutive parameters
+  integer, dimension(:), allocatable :: kinematics_cleavage_opening_instance
-   integer(pInt) :: &
+
-     totalNcleavage
+  type :: tParameters                                                                               !< container type for internal constitutive parameters
-   integer(pInt), dimension(:),   allocatable :: &
+    integer :: &
-     Ncleavage                                                                                      !< active number of cleavage systems per family
+      totalNcleavage
-   real(pReal) :: &
+    integer, dimension(:),   allocatable :: &
-     sdot0, &
+      Ncleavage                                                                                     !< active number of cleavage systems per family
-     n
+    real(pReal) :: &
-   real(pReal),   dimension(:),   allocatable :: &
+      sdot0, &
-     critDisp, &
+      n
-     critLoad
+    real(pReal),   dimension(:),   allocatable :: &
- end type
+      critDisp, &
+      critLoad
+  end type
 
 ! Begin Deprecated
- integer(pInt),                       dimension(:),           allocatable,         private :: &
+  integer,                       dimension(:),           allocatable :: &
-   kinematics_cleavage_opening_totalNcleavage                                                                    !< total number of cleavage systems
+    kinematics_cleavage_opening_totalNcleavage                                                      !< total number of cleavage systems
-   
+    
- integer(pInt),                       dimension(:,:),         allocatable,         private :: &
+  integer,                       dimension(:,:),         allocatable :: &
-   kinematics_cleavage_opening_Ncleavage                                                                         !< number of cleavage systems per family
+    kinematics_cleavage_opening_Ncleavage                                                           !< number of cleavage systems per family
-   
+    
- real(pReal),                         dimension(:),           allocatable,         private :: &
+  real(pReal),                   dimension(:),           allocatable :: &
-   kinematics_cleavage_opening_sdot_0, &
+    kinematics_cleavage_opening_sdot_0, &
-   kinematics_cleavage_opening_N
+    kinematics_cleavage_opening_N
 
- real(pReal),                         dimension(:,:),         allocatable,         private :: &
+  real(pReal),                   dimension(:,:),         allocatable :: &
-   kinematics_cleavage_opening_critDisp, &
+    kinematics_cleavage_opening_critDisp, &
-   kinematics_cleavage_opening_critLoad
+    kinematics_cleavage_opening_critLoad
 ! End Deprecated
 
- public :: &
+  public :: &
-   kinematics_cleavage_opening_init, &
+    kinematics_cleavage_opening_init, &
-   kinematics_cleavage_opening_LiAndItsTangent
+    kinematics_cleavage_opening_LiAndItsTangent
 
 contains
 
@@ -53,174 +58,144 @@ contains
 !> @brief module initialization
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
-subroutine kinematics_cleavage_opening_init()
+subroutine kinematics_cleavage_opening_init
- use debug, only: &
-   debug_level,&
-   debug_constitutive,&
-   debug_levelBasic
- use config, only: &
-   config_phase
- use IO, only: &
-   IO_error
- use material, only: &
-   phase_kinematics, &
-   KINEMATICS_cleavage_opening_label, &
-   KINEMATICS_cleavage_opening_ID
- use lattice, only: &
-   lattice_maxNcleavageFamily, &
-   lattice_NcleavageSystem
 
- implicit none
+  integer, allocatable, dimension(:) :: tempInt
- integer(pInt), allocatable, dimension(:) :: tempInt
+  real(pReal), allocatable, dimension(:) :: tempFloat
- real(pReal), allocatable, dimension(:) :: tempFloat
 
- integer(pInt) :: maxNinstance,p,instance,kinematics
+  integer :: maxNinstance,p,instance
 
- write(6,'(/,a)')   ' <<<+-  kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init  -+>>>'
+  write(6,'(/,a)')   ' <<<+-  kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init  -+>>>'
 
- maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt)
+  maxNinstance = count(phase_kinematics == KINEMATICS_cleavage_opening_ID)
- if (maxNinstance == 0_pInt) return
+  if (maxNinstance == 0) return
- 
+  
- if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
+  if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
-   write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
+    write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
- 
+  
- allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0_pInt)
+  allocate(kinematics_cleavage_opening_instance(size(config_phase)), source=0)
- do p = 1_pInt, size(config_phase)
+  do p = 1, size(config_phase)
-   kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct?
+    kinematics_cleavage_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_cleavage_opening_ID) ! ToDo: count correct?
- enddo
+  enddo
-   
+    
- allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance),  source=0.0_pReal) 
+  allocate(kinematics_cleavage_opening_critDisp(lattice_maxNcleavageFamily,maxNinstance),  source=0.0_pReal) 
- allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance),  source=0.0_pReal) 
+  allocate(kinematics_cleavage_opening_critLoad(lattice_maxNcleavageFamily,maxNinstance),  source=0.0_pReal) 
- allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0_pInt)
+  allocate(kinematics_cleavage_opening_Ncleavage(lattice_maxNcleavageFamily,maxNinstance), source=0)
- allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance),                       source=0_pInt)
+  allocate(kinematics_cleavage_opening_totalNcleavage(maxNinstance),                       source=0)
- allocate(kinematics_cleavage_opening_sdot_0(maxNinstance),                               source=0.0_pReal) 
+  allocate(kinematics_cleavage_opening_sdot_0(maxNinstance),                               source=0.0_pReal) 
- allocate(kinematics_cleavage_opening_N(maxNinstance),                                    source=0.0_pReal) 
+  allocate(kinematics_cleavage_opening_N(maxNinstance),                                    source=0.0_pReal) 
 
- do p = 1_pInt, size(config_phase)
+  do p = 1, size(config_phase)
-   if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle
+    if (all(phase_kinematics(:,p) /= KINEMATICS_cleavage_opening_ID)) cycle
-   instance = kinematics_cleavage_opening_instance(p)
+    instance = kinematics_cleavage_opening_instance(p)
-   kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0')
+    kinematics_cleavage_opening_sdot_0(instance) = config_phase(p)%getFloat('anisobrittle_sdot0')
-   kinematics_cleavage_opening_N(instance)      = config_phase(p)%getFloat('anisobrittle_ratesensitivity')
+    kinematics_cleavage_opening_N(instance)      = config_phase(p)%getFloat('anisobrittle_ratesensitivity')
-   tempInt = config_phase(p)%getInts('ncleavage')     
+    tempInt = config_phase(p)%getInts('ncleavage')     
-   kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt
+    kinematics_cleavage_opening_Ncleavage(1:size(tempInt),instance) = tempInt
 
-   tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(tempInt))
+    tempFloat = config_phase(p)%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(tempInt))
-   kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat
+    kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) = tempFloat
 
-   tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredSize=size(tempInt))
+    tempFloat = config_phase(p)%getFloats('anisobrittle_criticalload',requiredSize=size(tempInt))
-   kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat
+    kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) = tempFloat
 
-   kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = &
+    kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance) = &
-       min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,p),&                            ! limit active cleavage systems per family to min of available and requested
+        min(lattice_NcleavageSystem(1:lattice_maxNcleavageFamily,p),&                            ! limit active cleavage systems per family to min of available and requested
-           kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance))
+            kinematics_cleavage_opening_Ncleavage(1:lattice_maxNcleavageFamily,instance))
-     kinematics_cleavage_opening_totalNcleavage(instance)  = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether
+      kinematics_cleavage_opening_totalNcleavage(instance)  = sum(kinematics_cleavage_opening_Ncleavage(:,instance)) ! how many cleavage systems altogether
-     if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) &
+      if (kinematics_cleavage_opening_sdot_0(instance) <= 0.0_pReal) &
-       call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')')
+        call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_cleavage_opening_LABEL//')')
-     if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) &
+      if (any(kinematics_cleavage_opening_critDisp(1:size(tempInt),instance) < 0.0_pReal)) &
-       call IO_error(211_pInt,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')')
+        call IO_error(211,el=instance,ext_msg='critical_displacement ('//KINEMATICS_cleavage_opening_LABEL//')')
-     if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) &
+      if (any(kinematics_cleavage_opening_critLoad(1:size(tempInt),instance) < 0.0_pReal)) &
-       call IO_error(211_pInt,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')')
+        call IO_error(211,el=instance,ext_msg='critical_load ('//KINEMATICS_cleavage_opening_LABEL//')')
-     if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) &
+      if (kinematics_cleavage_opening_N(instance) <= 0.0_pReal) &
-       call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')')
+        call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_cleavage_opening_LABEL//')')
- enddo
+  enddo
  
 end subroutine kinematics_cleavage_opening_init
-
+ 
 !--------------------------------------------------------------------------------------------------
 !> @brief  contains the constitutive equation for calculating the velocity gradient  
 !--------------------------------------------------------------------------------------------------
 subroutine kinematics_cleavage_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
- use prec, only: &
-   tol_math_check
- use math, only: &
-   math_mul33xx33
- use material, only: &
-   material_phase, &
-   material_homogenizationAt, &
-   damage, &
-   damageMapping
- use lattice, only: &
-   lattice_Scleavage, &
-   lattice_maxNcleavageFamily, &
-   lattice_NcleavageSystem
  
- implicit none
+  integer, intent(in) :: &
- integer(pInt), intent(in) :: &
+    ipc, &                                                                                          !< grain number
-   ipc, &                                                                                           !< grain number
+    ip, &                                                                                           !< integration point number
-   ip, &                                                                                            !< integration point number
+    el                                                                                              !< element number
-   el                                                                                               !< element number
+  real(pReal),   intent(in),  dimension(3,3) :: &
- real(pReal),   intent(in),  dimension(3,3) :: &
+    S
-   S
+  real(pReal),   intent(out), dimension(3,3) :: &
- real(pReal),   intent(out), dimension(3,3) :: &
+    Ld                                                                                              !< damage velocity gradient
-   Ld                                                                                               !< damage velocity gradient
+  real(pReal),   intent(out), dimension(3,3,3,3) :: &
- real(pReal),   intent(out), dimension(3,3,3,3) :: &
+    dLd_dTstar                                                                                      !< derivative of Ld with respect to Tstar (4th-order tensor)
-   dLd_dTstar                                                                                       !< derivative of Ld with respect to Tstar (4th-order tensor)
+  integer :: &
- integer(pInt) :: &
+    instance, phase, &
-   instance, phase, &
+    homog, damageOffset, &
-   homog, damageOffset, &
+    f, i, index_myFamily, k, l, m, n
-   f, i, index_myFamily, k, l, m, n
+  real(pReal) :: &
- real(pReal) :: &
+    traction_d, traction_t, traction_n, traction_crit, &
-   traction_d, traction_t, traction_n, traction_crit, &
+    udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt
-   udotd, dudotd_dt, udott, dudott_dt, udotn, dudotn_dt
 
- phase = material_phase(ipc,ip,el)
+  phase = material_phase(ipc,ip,el)
- instance = kinematics_cleavage_opening_instance(phase)
+  instance = kinematics_cleavage_opening_instance(phase)
- homog = material_homogenizationAt(el)
+  homog = material_homogenizationAt(el)
- damageOffset = damageMapping(homog)%p(ip,el)
+  damageOffset = damageMapping(homog)%p(ip,el)
- 
+  
- Ld = 0.0_pReal
+  Ld = 0.0_pReal
- dLd_dTstar = 0.0_pReal
+  dLd_dTstar = 0.0_pReal
- do f = 1_pInt,lattice_maxNcleavageFamily
+  do f = 1,lattice_maxNcleavageFamily
-   index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase))                                   ! at which index starts my family
+    index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase))                                      ! at which index starts my family
-   do i = 1_pInt,kinematics_cleavage_opening_Ncleavage(f,instance)                                            ! process each (active) cleavage system in family
+    do i = 1,kinematics_cleavage_opening_Ncleavage(f,instance)                                      ! process each (active) cleavage system in family
-     traction_d    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase))
+      traction_d    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase))
-     traction_t    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase))
+      traction_t    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase))
-     traction_n    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase))
+      traction_n    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase))
-     traction_crit = kinematics_cleavage_opening_critLoad(f,instance)* &
+      traction_crit = kinematics_cleavage_opening_critLoad(f,instance)* &
-                     damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset)
+                      damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset)
-     udotd = &
+      udotd = &
-       sign(1.0_pReal,traction_d)* &
+        sign(1.0_pReal,traction_d)* &
-       kinematics_cleavage_opening_sdot_0(instance)* &
+        kinematics_cleavage_opening_sdot_0(instance)* &
-       (max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance)
+        (max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance)
-     if (abs(udotd) > tol_math_check) then
+      if (abs(udotd) > tol_math_check) then
-       Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)
+        Ld = Ld + udotd*lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase)
-       dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ &
+        dudotd_dt = sign(1.0_pReal,traction_d)*udotd*kinematics_cleavage_opening_N(instance)/ &
-                   max(0.0_pReal, abs(traction_d) - traction_crit)
+                    max(0.0_pReal, abs(traction_d) - traction_crit)
-       forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
+        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) + &
+          dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
-           dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* &
+            dudotd_dt*lattice_Scleavage(k,l,1,index_myFamily+i,phase)* &
-                     lattice_Scleavage(m,n,1,index_myFamily+i,phase)
+                      lattice_Scleavage(m,n,1,index_myFamily+i,phase)
-     endif                
+      endif                
 
-     udott = &
+      udott = &
-       sign(1.0_pReal,traction_t)* &
+        sign(1.0_pReal,traction_t)* &
-       kinematics_cleavage_opening_sdot_0(instance)* &
+        kinematics_cleavage_opening_sdot_0(instance)* &
-       (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance)
+        (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance)
-     if (abs(udott) > tol_math_check) then
+      if (abs(udott) > tol_math_check) then
-       Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)
+        Ld = Ld + udott*lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase)
-       dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ &
+        dudott_dt = sign(1.0_pReal,traction_t)*udott*kinematics_cleavage_opening_N(instance)/ &
-                   max(0.0_pReal, abs(traction_t) - traction_crit)  
+                    max(0.0_pReal, abs(traction_t) - traction_crit)  
-       forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
+        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) + &
+          dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
-           dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* &
+            dudott_dt*lattice_Scleavage(k,l,2,index_myFamily+i,phase)* &
-                     lattice_Scleavage(m,n,2,index_myFamily+i,phase)
+                      lattice_Scleavage(m,n,2,index_myFamily+i,phase)
-     endif                
+      endif                
 
-     udotn = &
+      udotn = &
-       sign(1.0_pReal,traction_n)* &
+        sign(1.0_pReal,traction_n)* &
-       kinematics_cleavage_opening_sdot_0(instance)* &
+        kinematics_cleavage_opening_sdot_0(instance)* &
-       (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance)
+        (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**kinematics_cleavage_opening_N(instance)
-     if (abs(udotn) > tol_math_check) then
+      if (abs(udotn) > tol_math_check) then
-       Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)
+        Ld = Ld + udotn*lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase)
-       dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ &
+        dudotn_dt = sign(1.0_pReal,traction_n)*udotn*kinematics_cleavage_opening_N(instance)/ &
-                   max(0.0_pReal, abs(traction_n) - traction_crit)
+                    max(0.0_pReal, abs(traction_n) - traction_crit)
-       forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
+        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) + &
+          dLd_dTstar(k,l,m,n) = dLd_dTstar(k,l,m,n) + &
-           dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* &
+            dudotn_dt*lattice_Scleavage(k,l,3,index_myFamily+i,phase)* &
-                     lattice_Scleavage(m,n,3,index_myFamily+i,phase)
+                      lattice_Scleavage(m,n,3,index_myFamily+i,phase)
-     endif                
+      endif                
-   enddo
+    enddo
- enddo
+  enddo
  
 end subroutine kinematics_cleavage_opening_LiAndItsTangent
 

src/kinematics_slipplane_opening.f90

@@ -5,23 +5,28 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module kinematics_slipplane_opening
- use prec, only: &
+ use prec
-   pReal, &
+ use config
-   pInt
+ use IO
+ use debug
+ use math
+ use lattice
+ use material
 
  implicit none
  private
- integer(pInt), dimension(:), allocatable, private :: kinematics_slipplane_opening_instance
+ 
+ integer, dimension(:), allocatable :: kinematics_slipplane_opening_instance
    
- type, private :: tParameters                                                                       !< container type for internal constitutive parameters
+ type :: tParameters                                                                                !< container type for internal constitutive parameters
-   integer(pInt) :: &
+   integer :: &
      totalNslip
-   integer(pInt), dimension(:),   allocatable :: &
+   integer, dimension(:),   allocatable :: &
      Nslip                                                                                          !< active number of slip systems per family
    real(pReal) :: &
      sdot0, &
      n
-   real(pReal),   dimension(:),   allocatable :: &
+   real(pReal), dimension(:),   allocatable :: &
      critLoad
    real(pReal), dimension(:,:), allocatable     :: &
     slip_direction, &
@@ -29,7 +34,8 @@ module kinematics_slipplane_opening
     slip_transverse
  end type tParameters
 
-     type(tParameters), dimension(:), allocatable, private :: param                                     !< containers of constitutive parameters (len Ninstance)
+ type(tParameters), dimension(:), allocatable :: param                                            !< containers of constitutive parameters (len Ninstance)
+ 
  public :: &
    kinematics_slipplane_opening_init, &
    kinematics_slipplane_opening_LiAndItsTangent
@@ -41,43 +47,26 @@ contains
 !> @brief module initialization
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
-subroutine kinematics_slipplane_opening_init()
+subroutine kinematics_slipplane_opening_init
- use debug, only: &
-   debug_level,&
-   debug_constitutive,&
-   debug_levelBasic
- use config, only: &
-   config_phase
- use IO, only: &
-   IO_error
- use math, only: &
-   math_expand
- use material, only: &
-   phase_kinematics, &
-   KINEMATICS_slipplane_opening_label, &
-   KINEMATICS_slipplane_opening_ID
- use lattice
 
- implicit none
+ integer :: maxNinstance,p,instance
-
- integer(pInt) :: maxNinstance,p,instance,kinematics
 
  write(6,'(/,a)')   ' <<<+-  kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init  -+>>>'
 
  maxNinstance = count(phase_kinematics == KINEMATICS_slipplane_opening_ID)
  if (maxNinstance == 0) return
  
- if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
+ if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
    write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance
  
- allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0_pInt)
+ allocate(kinematics_slipplane_opening_instance(size(config_phase)), source=0)
- do p = 1_pInt, size(config_phase)
+ do p = 1, size(config_phase)
    kinematics_slipplane_opening_instance(p) = count(phase_kinematics(:,1:p) == kinematics_slipplane_opening_ID) ! ToDo: count correct?
  enddo
  
  allocate(param(maxNinstance))
  
- do p = 1_pInt, size(config_phase)
+ do p = 1, size(config_phase)
    if (all(phase_kinematics(:,p) /= KINEMATICS_slipplane_opening_ID)) cycle
    associate(prm => param(kinematics_slipplane_opening_instance(p)), &
             config => config_phase(p))
@@ -91,19 +80,19 @@ subroutine kinematics_slipplane_opening_init()
 
    prm%critLoad = math_expand(prm%critLoad, prm%Nslip)
       
-prm%slip_direction  = lattice_slip_direction  (prm%Nslip,config%getString('lattice_structure'),&
+   prm%slip_direction  = lattice_slip_direction  (prm%Nslip,config%getString('lattice_structure'),&
                                                     config%getFloat('c/a',defaultVal=0.0_pReal))
-      prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),&
+   prm%slip_normal = lattice_slip_normal (prm%Nslip,config%getString('lattice_structure'),&
                                                     config%getFloat('c/a',defaultVal=0.0_pReal))
-      prm%slip_transverse     = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),&
+   prm%slip_transverse     = lattice_slip_transverse(prm%Nslip,config%getString('lattice_structure'),&
                                                     config%getFloat('c/a',defaultVal=0.0_pReal))
 
    !  if (kinematics_slipplane_opening_sdot_0(instance) <= 0.0_pReal) &
-   !    call IO_error(211_pInt,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')')
+   !    call IO_error(211,el=instance,ext_msg='sdot_0 ('//KINEMATICS_slipplane_opening_LABEL//')')
    !  if (any(kinematics_slipplane_opening_critPlasticStrain(:,instance) < 0.0_pReal)) &
-   !    call IO_error(211_pInt,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')')
+   !    call IO_error(211,el=instance,ext_msg='criticaPlasticStrain ('//KINEMATICS_slipplane_opening_LABEL//')')
    !  if (kinematics_slipplane_opening_N(instance) <= 0.0_pReal) &
-   !    call IO_error(211_pInt,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')')
+   !    call IO_error(211,el=instance,ext_msg='rate_sensitivity ('//KINEMATICS_slipplane_opening_LABEL//')')
  
    end associate
  enddo
@@ -114,18 +103,7 @@ end subroutine kinematics_slipplane_opening_init
 !> @brief  contains the constitutive equation for calculating the velocity gradient  
 !--------------------------------------------------------------------------------------------------
 subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc, ip, el)
- use prec, only: &
-   tol_math_check
- use math, only: &
-   math_mul33xx33, &
-   math_outer
- use material, only: &
-   material_phase, &
-   material_homogenizationAt, &
-   damage, &
-   damageMapping
 
- implicit none
  integer, intent(in) :: &
    ipc, &                                                                                           !< grain number
    ip, &                                                                                            !< integration point number
@@ -173,7 +151,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc,
      if (abs(udotd) > tol_math_check) then
        Ld = Ld + udotd*projection_d
        dudotd_dt = udotd*prm%n/traction_d
-       forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
+       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*projection_d(k,l)*projection_d(m,n)
      endif                
@@ -185,7 +163,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc,
      if (abs(udott) > tol_math_check) then
        Ld = Ld + udott*projection_t
        dudott_dt = udott*prm%n/traction_t
-       forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
+       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*projection_t(k,l)*projection_t(m,n)
      endif
@@ -197,7 +175,7 @@ subroutine kinematics_slipplane_opening_LiAndItsTangent(Ld, dLd_dTstar, S, ipc,
      if (abs(udotn) > tol_math_check) then
        Ld = Ld + udotn*projection_n
        dudotn_dt = udotn*prm%n/traction_n
-       forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) &
+       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*projection_n(k,l)*projection_n(m,n)
      endif 

src/kinematics_thermal_expansion.f90

@@ -4,14 +4,18 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module kinematics_thermal_expansion
-  use prec, only: &
+  use prec
-    pReal, &
+  use IO
-    pInt
+  use config
-
+  use debug
+  use math
+  use lattice
+  use material
+  
   implicit none
   private
  
-  type, private :: tParameters
+  type :: tParameters
     real(pReal), allocatable, dimension(:,:,:) :: &
       expansion
   end type tParameters
@@ -30,20 +34,9 @@ contains
 !> @brief module initialization
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
-subroutine kinematics_thermal_expansion_init()
+subroutine kinematics_thermal_expansion_init
-  use debug, only: &
-    debug_level,&
-    debug_constitutive,&
-    debug_levelBasic
-  use material, only: &
-    phase_kinematics, &
-    KINEMATICS_thermal_expansion_label, &
-    KINEMATICS_thermal_expansion_ID
-  use config, only: &
-    config_phase
  
-  implicit none
+  integer :: &
-  integer(pInt) :: &
     Ninstance, &
     p, i
   real(pReal),  dimension(:), allocatable :: &
@@ -51,14 +44,14 @@ subroutine kinematics_thermal_expansion_init()
   
   write(6,'(/,a)')   ' <<<+-  kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init  -+>>>'
  
-  Ninstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt)
+  Ninstance = count(phase_kinematics == KINEMATICS_thermal_expansion_ID)
   
-  if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
+  if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
     write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
   
   allocate(param(Ninstance))
   
-  do p = 1_pInt, size(phase_kinematics)
+  do p = 1, size(phase_kinematics)
     if (all(phase_kinematics(:,p) /= KINEMATICS_thermal_expansion_ID)) cycle
     
     ! ToDo: Here we need to decide how to extend the concept of instances to
@@ -81,14 +74,8 @@ end subroutine kinematics_thermal_expansion_init
 !> @brief  report initial thermal strain based on current temperature deviation from reference
 !--------------------------------------------------------------------------------------------------
 pure function kinematics_thermal_expansion_initialStrain(homog,phase,offset)
-  use material, only: &
-    temperature
-  use lattice, only: &
-    lattice_thermalExpansion33, &
-    lattice_referenceTemperature
   
-  implicit none
+  integer, intent(in) :: &
-  integer(pInt), intent(in) :: &
     phase, &
     homog, offset
   real(pReal), dimension(3,3) :: &
@@ -110,18 +97,8 @@ end function kinematics_thermal_expansion_initialStrain
 !> @brief  contains the constitutive equation for calculating the velocity gradient  
 !--------------------------------------------------------------------------------------------------
 subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip, el)
-  use material, only: &
-    material_phase, &
-   material_homogenizationAt, &
-    temperature, &
-    temperatureRate, &
-    thermalMapping
-  use lattice, only: &
-    lattice_thermalExpansion33, &
-    lattice_referenceTemperature
   
-  implicit none
+  integer, intent(in) :: &
-  integer(pInt), intent(in) :: &
     ipc, &                                                                                           !< grain number
     ip, &                                                                                            !< integration point number
     el                                                                                               !< element number
@@ -129,7 +106,7 @@ subroutine kinematics_thermal_expansion_LiAndItsTangent(Li, dLi_dTstar, ipc, ip,
     Li                                                                                               !< thermal velocity gradient
   real(pReal),   intent(out), dimension(3,3,3,3) :: &
     dLi_dTstar                                                                                       !< derivative of Li with respect to Tstar (4th-order tensor defined to be zero)
-  integer(pInt) :: &
+  integer :: &
     phase, &
     homog, offset
   real(pReal) :: &

src/lattice.f90

@@ -7,8 +7,10 @@
 !          and cleavage as well as interaction among the various systems
 !--------------------------------------------------------------------------------------------------
 module lattice
-  use prec, only: &
+  use prec
-    pReal
+  use IO
+  use config
+  use math
   use future
  
   implicit none
@@ -28,25 +30,25 @@ module lattice
 
 !--------------------------------------------------------------------------------------------------
 ! face centered cubic
-  integer, dimension(2), parameter, private :: &
+  integer, dimension(2), parameter :: &
     LATTICE_FCC_NSLIPSYSTEM = [12, 6]                                                               !< # of slip systems per family for fcc
  
-  integer, dimension(1), parameter, private :: &
+  integer, dimension(1), parameter :: &
     LATTICE_FCC_NTWINSYSTEM = [12]                                                                  !< # of twin systems per family for fcc
  
-  integer, dimension(1), parameter, private :: &
+  integer, dimension(1), parameter :: &
     LATTICE_FCC_NTRANSSYSTEM = [12]                                                                 !< # of transformation systems per family for fcc
  
-  integer, dimension(2), parameter, private :: &
+  integer, dimension(2), parameter :: &
     LATTICE_FCC_NCLEAVAGESYSTEM = [3, 4]                                                            !< # of cleavage systems per family for fcc
  
-  integer, parameter, private  :: &
+  integer, parameter  :: &
     LATTICE_FCC_NSLIP      = sum(LATTICE_FCC_NSLIPSYSTEM), &                                        !< total # of slip systems for fcc
     LATTICE_FCC_NTWIN      = sum(LATTICE_FCC_NTWINSYSTEM), &                                        !< total # of twin systems for fcc
     LATTICE_FCC_NTRANS     = sum(LATTICE_FCC_NTRANSSYSTEM), &                                       !< total # of transformation systems for fcc
     LATTICE_FCC_NCLEAVAGE  = sum(LATTICE_FCC_NCLEAVAGESYSTEM)                                       !< total # of cleavage systems for fcc
  
-  real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter, private :: &
+  real(pReal), dimension(3+3,LATTICE_FCC_NSLIP), parameter :: &
     LATTICE_FCC_SYSTEMSLIP = reshape(real([&
      ! Slip direction     Plane normal                                                              ! SCHMID-BOAS notation
        0, 1,-1,     1, 1, 1, &                                                                      ! B2
@@ -70,11 +72,11 @@ module lattice
        0, 1,-1,     0, 1, 1  &
       ],pReal),shape(LATTICE_FCC_SYSTEMSLIP))                                                       !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli
  
-  character(len=*), dimension(2), parameter, private :: LATTICE_FCC_SLIPFAMILY_NAME = &
+  character(len=*), dimension(2), parameter :: LATTICE_FCC_SLIPFAMILY_NAME = &
     ['<0 1 -1>{1 1 1}', &
      '<0 1 -1>{0 1 1}']
  
-  real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter, private :: &
+  real(pReal), dimension(3+3,LATTICE_FCC_NTWIN), parameter :: &
     LATTICE_FCC_SYSTEMTWIN = reshape(real( [&
       -2, 1, 1,     1, 1, 1, &
        1,-2, 1,     1, 1, 1, &
@@ -90,7 +92,7 @@ module lattice
       -1, 1, 2,    -1, 1,-1  &
       ],pReal),shape(LATTICE_FCC_SYSTEMTWIN))                                                       !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli
  
-  character(len=*), dimension(1), parameter, private :: LATTICE_FCC_TWINFAMILY_NAME = &
+  character(len=*), dimension(1), parameter :: LATTICE_FCC_TWINFAMILY_NAME = &
     ['<-2 1 1>{1 1 1}']
  
  
@@ -110,7 +112,7 @@ module lattice
       10,11 &
       ],shape(LATTICE_FCC_TWINNUCLEATIONSLIPPAIR))
  
-  real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter, private :: &
+  real(pReal), dimension(3+3,LATTICE_FCC_NCLEAVAGE), parameter :: &
     LATTICE_FCC_SYSTEMCLEAVAGE = reshape(real([&
      ! Cleavage direction     Plane normal
        0, 1, 0,     1, 0, 0, &
@@ -124,21 +126,21 @@ module lattice
  
 !--------------------------------------------------------------------------------------------------
 ! body centered cubic
-  integer, dimension(2), parameter, private :: &
+  integer, dimension(2), parameter :: &
     LATTICE_BCC_NSLIPSYSTEM = [12, 12]                                                              !< # of slip systems per family for bcc
  
-  integer, dimension(1), parameter, private :: &
+  integer, dimension(1), parameter :: &
     LATTICE_BCC_NTWINSYSTEM = [12]                                                                  !< # of twin systems per family for bcc
  
-  integer, dimension(2), parameter, private :: &
+  integer, dimension(2), parameter :: &
     LATTICE_BCC_NCLEAVAGESYSTEM = [3, 6]                                                            !< # of cleavage systems per family for bcc
  
-  integer, parameter, private  :: &
+  integer, parameter  :: &
     LATTICE_BCC_NSLIP      = sum(LATTICE_BCC_NSLIPSYSTEM), &                                        !< total # of slip systems for bcc
     LATTICE_BCC_NTWIN      = sum(LATTICE_BCC_NTWINSYSTEM), &                                        !< total # of twin systems for bcc
     LATTICE_BCC_NCLEAVAGE  = sum(LATTICE_BCC_NCLEAVAGESYSTEM)                                       !< total # of cleavage systems for bcc
  
-  real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter, private :: &
+  real(pReal), dimension(3+3,LATTICE_BCC_NSLIP), parameter :: &
     LATTICE_BCC_SYSTEMSLIP = reshape(real([&
      ! Slip direction     Plane normal
      ! Slip system <111>{110}
@@ -169,11 +171,11 @@ module lattice
        1, 1, 1,     1, 1,-2  &
       ],pReal),shape(LATTICE_BCC_SYSTEMSLIP))
  
-  character(len=*), dimension(2), parameter, private :: LATTICE_BCC_SLIPFAMILY_NAME = &
+  character(len=*), dimension(2), parameter :: LATTICE_BCC_SLIPFAMILY_NAME = &
     ['<1 -1 1>{0 1 1}', &
      '<1 -1 1>{2 1 1}']
  
-  real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter, private :: &
+  real(pReal), dimension(3+3,LATTICE_BCC_NTWIN), parameter :: &
     LATTICE_BCC_SYSTEMTWIN = reshape(real([&
      ! Twin system <111>{112}
       -1, 1, 1,     2, 1, 1, &
@@ -190,10 +192,10 @@ module lattice
        1, 1, 1,     1, 1,-2  &
       ],pReal),shape(LATTICE_BCC_SYSTEMTWIN))
  
-  character(len=*), dimension(1), parameter, private :: LATTICE_BCC_TWINFAMILY_NAME = &
+  character(len=*), dimension(1), parameter :: LATTICE_BCC_TWINFAMILY_NAME = &
     ['<1 1 1>{2 1 1}']
  
-  real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter, private :: &
+  real(pReal), dimension(3+3,LATTICE_BCC_NCLEAVAGE), parameter :: &
     LATTICE_BCC_SYSTEMCLEAVAGE = reshape(real([&
      ! Cleavage direction     Plane normal
        0, 1, 0,     1, 0, 0, &
@@ -209,21 +211,21 @@ module lattice
  
 !--------------------------------------------------------------------------------------------------
 ! hexagonal
-  integer, dimension(6), parameter, private :: &
+  integer, dimension(6), parameter :: &
     LATTICE_HEX_NSLIPSYSTEM = [3, 3, 3, 6, 12, 6]                                                   !< # of slip systems per family for hex
  
-  integer, dimension(4), parameter, private :: &
+  integer, dimension(4), parameter :: &
     LATTICE_HEX_NTWINSYSTEM = [6, 6, 6, 6]                                                          !< # of slip systems per family for hex
  
-  integer, dimension(1), parameter, private :: &
+  integer, dimension(1), parameter :: &
     LATTICE_HEX_NCLEAVAGESYSTEM = [3]                                                               !< # of cleavage systems per family for hex
  
-  integer, parameter, private  :: &
+  integer, parameter  :: &
     LATTICE_HEX_NSLIP      = sum(LATTICE_HEX_NSLIPSYSTEM), &                                        !< total # of slip systems for hex
     LATTICE_HEX_NTWIN      = sum(LATTICE_HEX_NTWINSYSTEM), &                                        !< total # of twin systems for hex
     LATTICE_HEX_NCLEAVAGE  = sum(LATTICE_HEX_NCLEAVAGESYSTEM)                                       !< total # of cleavage systems for hex
  
-  real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter, private :: &
+  real(pReal), dimension(4+4,LATTICE_HEX_NSLIP), parameter :: &
     LATTICE_HEX_SYSTEMSLIP = reshape(real([&
      ! Slip direction     Plane normal
      ! Basal systems <11.0>{00.1} (independent of c/a-ratio, Bravais notation (4 coordinate base))
@@ -267,7 +269,7 @@ module lattice
        1,  1, -2,  3,    -1, -1,  2,  2  &
       ],pReal),shape(LATTICE_HEX_SYSTEMSLIP))                                                       !< slip systems for hex sorted by A. Alankar & P. Eisenlohr
  
-  character(len=*), dimension(6), parameter, private :: LATTICE_HEX_SLIPFAMILY_NAME = &
+  character(len=*), dimension(6), parameter :: LATTICE_HEX_SLIPFAMILY_NAME = &
     ['<1 1 . 1>{0 0 . 1}  ', &
      '<1 1 . 1>{1 0 . 0}  ', &
      '<1 0 . 0>{1 1 . 0}  ', &
@@ -275,7 +277,7 @@ module lattice
      '<1 1 . 3>{-1 0 . 1} ', &
      '<1 1 . 3>{-1 -1 . 2}']
  
-  real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter, private :: &
+  real(pReal), dimension(4+4,LATTICE_HEX_NTWIN), parameter :: &
     LATTICE_HEX_SYSTEMTWIN =  reshape(real([&
      ! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981)
        1, -1,  0,  1,    -1,  1,  0,  2, & ! <-10.1>{10.2} shear = (3-(c/a)^2)/(sqrt(3) c/a)
@@ -307,13 +309,13 @@ module lattice
        1,  1, -2, -3,     1,  1, -2,  2  &
       ],pReal),shape(LATTICE_HEX_SYSTEMTWIN))                                                       !< twin systems for hex, order follows Prof. Tom Bieler's scheme
  
-  character(len=*), dimension(4), parameter, private :: LATTICE_HEX_TWINFAMILY_NAME = &
+  character(len=*), dimension(4), parameter :: LATTICE_HEX_TWINFAMILY_NAME = &
     ['<-1 0 . 1>{1 0 . 2} ', &
      '<1 1 . 6>{-1 -1 . 1}', &
      '<1 0 . -2>{1 0 . 1} ', &
      '<1 1 . -3>{1 1 . 2} ']
  
-  real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter, private :: &
+  real(pReal), dimension(4+4,LATTICE_HEX_NCLEAVAGE), parameter :: &
     LATTICE_HEX_SYSTEMCLEAVAGE = reshape(real([&
      ! Cleavage direction     Plane normal
        2,-1,-1, 0,     0, 0, 0, 1, &
@@ -324,13 +326,13 @@ module lattice
  
 !--------------------------------------------------------------------------------------------------
 ! body centered tetragonal
-  integer, dimension(13), parameter, private :: &
+  integer, dimension(13), parameter :: &
     LATTICE_BCT_NSLIPSYSTEM = [2, 2, 2, 4, 2, 4, 2, 2, 4, 8, 4, 8, 8 ]                              !< # of slip systems per family for bct (Sn) Bieler J. Electr Mater 2009
  
-  integer, parameter, private  :: &
+  integer, parameter :: &
     LATTICE_BCT_NSLIP       = sum(LATTICE_BCT_NSLIPSYSTEM)                                          !< total # of slip systems for bct
  
-  real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter, private :: &
+  real(pReal), dimension(3+3,LATTICE_BCT_NSLIP), parameter :: &
     LATTICE_BCT_SYSTEMSLIP = reshape(real([&
      ! Slip direction     Plane normal
      ! Slip family 1 {100)<001] (Bravais notation {hkl)<uvw] for bct c/a = 0.5456)
@@ -400,7 +402,7 @@ module lattice
        1, 1, 1,      1,-2, 1  &
        ],pReal),[ 3 + 3,LATTICE_BCT_NSLIP])                                                         !< slip systems for bct sorted by Bieler
  
-  character(len=*), dimension(13), parameter, private :: LATTICE_BCT_SLIPFAMILY_NAME = &
+  character(len=*), dimension(13), parameter :: LATTICE_BCT_SLIPFAMILY_NAME = &
     ['{1 0 0)<0 0 1] ', &
      '{1 1 0)<0 0 1] ', &
      '{1 0 0)<0 1 0] ', &
@@ -418,13 +420,13 @@ module lattice
  
 !--------------------------------------------------------------------------------------------------
 ! isotropic
-  integer, dimension(1), parameter, private :: &
+  integer, dimension(1), parameter :: &
     LATTICE_ISO_NCLEAVAGESYSTEM = [3]                                                               !< # of cleavage systems per family for iso
  
-  integer, parameter, private  :: &
+  integer, parameter  :: &
     LATTICE_ISO_NCLEAVAGE  = sum(LATTICE_ISO_NCLEAVAGESYSTEM)                                       !< total # of cleavage systems for iso
  
-  real(pReal), dimension(3+3,LATTICE_ISO_NCLEAVAGE), parameter, private :: &
+  real(pReal), dimension(3+3,LATTICE_ISO_NCLEAVAGE), parameter :: &
     LATTICE_ISO_SYSTEMCLEAVAGE= reshape(real([&
      ! Cleavage direction     Plane normal
        0, 1, 0,     1, 0, 0, &
@@ -435,13 +437,13 @@ module lattice
  
 !--------------------------------------------------------------------------------------------------
 ! orthorhombic
-  integer, dimension(3), parameter, private :: &
+  integer, dimension(3), parameter :: &
     LATTICE_ORT_NCLEAVAGESYSTEM = [1, 1, 1]                                                         !< # of cleavage systems per family for ortho
  
-  integer, parameter, private  :: &
+  integer, parameter  :: &
     LATTICE_ORT_NCLEAVAGE  = sum(LATTICE_ORT_NCLEAVAGESYSTEM)                                       !< total # of cleavage systems for ortho
  
-  real(pReal), dimension(3+3,LATTICE_ORT_NCLEAVAGE), parameter, private :: &
+  real(pReal), dimension(3+3,LATTICE_ORT_NCLEAVAGE), parameter :: &
     LATTICE_ORT_SYSTEMCLEAVAGE = reshape(real([&
      ! Cleavage direction     Plane normal
        0, 1, 0,     1, 0, 0, &
@@ -541,10 +543,6 @@ module lattice
 !> @brief Module initialization
 !--------------------------------------------------------------------------------------------------
 subroutine lattice_init
-  use IO, only: &
-    IO_error
-  use config, only: &
-    config_phase
  
   integer :: Nphases
   character(len=65536) :: &
@@ -654,15 +652,7 @@ end subroutine lattice_init
 !> @brief !!!!!!!DEPRECTATED!!!!!!
 !--------------------------------------------------------------------------------------------------
 subroutine lattice_initializeStructure(myPhase,CoverA)
-  use prec, only: &
+
-   tol_math_check
-  use math, only: &
-    math_sym3333to66, &
-    math_Voigt66to3333, &
-    math_cross
-  use IO, only: &
-    IO_error
- 
   integer, intent(in) :: myPhase
   real(pReal), intent(in) :: &
     CoverA
@@ -690,9 +680,10 @@ subroutine lattice_initializeStructure(myPhase,CoverA)
       call IO_error(135,el=i,ip=myPhase,ext_msg='matrix diagonal "el"ement of phase "ip"')
   enddo
  
-  forall (i = 1:3) &
+  do i = 1,3
     lattice_thermalExpansion33 (1:3,1:3,i,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),&
                                                                           lattice_thermalExpansion33   (1:3,1:3,i,myPhase))
+  enddo
  
   lattice_thermalConductivity33  (1:3,1:3,myPhase) = lattice_symmetrize33(lattice_structure(myPhase),&
                                                                           lattice_thermalConductivity33  (1:3,1:3,myPhase))
@@ -763,17 +754,17 @@ pure function lattice_symmetrizeC66(struct,C66)
  
   select case(struct)
     case (LATTICE_iso_ID)
-      forall(k=1:3)
+      do k=1,3
         forall(j=1:3) lattice_symmetrizeC66(k,j) = C66(1,2)
         lattice_symmetrizeC66(k,k) = C66(1,1)
         lattice_symmetrizeC66(k+3,k+3) = 0.5_pReal*(C66(1,1)-C66(1,2))
-      end forall
+      enddo
     case (LATTICE_fcc_ID,LATTICE_bcc_ID)
-      forall(k=1:3)
+      do k=1,3
         forall(j=1:3) lattice_symmetrizeC66(k,j) =   C66(1,2)
         lattice_symmetrizeC66(k,k) =     C66(1,1)
         lattice_symmetrizeC66(k+3,k+3) = C66(4,4)
-      end forall
+      enddo
     case (LATTICE_hex_ID)
       lattice_symmetrizeC66(1,1) = C66(1,1)
       lattice_symmetrizeC66(2,2) = C66(1,1)
@@ -834,7 +825,9 @@ pure function lattice_symmetrize33(struct,T33)
  
   select case(struct)
     case (LATTICE_iso_ID,LATTICE_fcc_ID,LATTICE_bcc_ID)
-      forall(k=1:3) lattice_symmetrize33(k,k) = T33(1,1)
+      do k=1,3
+        lattice_symmetrize33(k,k) = T33(1,1)
+      enddo
     case (LATTICE_hex_ID)
       lattice_symmetrize33(1,1) = T33(1,1)
       lattice_symmetrize33(2,2) = T33(1,1)
@@ -854,10 +847,6 @@ end function lattice_symmetrize33
 !> @brief figures whether unit quat falls into stereographic standard triangle
 !--------------------------------------------------------------------------------------------------
 logical pure function lattice_qInSST(Q, struct)
-  use, intrinsic :: &
-    IEEE_arithmetic
-  use math, only: &
-    math_qToRodrig
  
   real(pReal), dimension(4), intent(in) ::      Q                                                   ! orientation
   integer(kind(LATTICE_undefined_ID)), intent(in) :: struct                                         ! lattice structure
@@ -888,11 +877,6 @@ end function lattice_qInSST
 !> @brief calculates the disorientation for 2 unit quaternions
 !--------------------------------------------------------------------------------------------------
 pure function lattice_qDisorientation(Q1, Q2, struct)
-  use prec, only: &
-   tol_math_check
-  use math, only: &
-    math_qMul, &
-    math_qConj
  
   real(pReal), dimension(4) ::                  lattice_qDisorientation
   real(pReal), dimension(4), intent(in) :: &
@@ -998,8 +982,6 @@ end function lattice_qDisorientation
 !> @brief Characteristic shear for twinning
 !--------------------------------------------------------------------------------------------------
 function lattice_characteristicShear_Twin(Ntwin,structure,CoverA) result(characteristicShear)
-  use IO, only: &
-    IO_error
  
   integer,     dimension(:),            intent(in) :: Ntwin                                         !< number of active twin systems per family
   character(len=*),                     intent(in) :: structure                                     !< lattice structure
@@ -1077,14 +1059,6 @@ end function lattice_characteristicShear_Twin
 !> @brief Rotated elasticity matrices for twinning in 66-vector notation
 !--------------------------------------------------------------------------------------------------
 function lattice_C66_twin(Ntwin,C66,structure,CoverA)
-  use IO, only: &
-    IO_error
-  use math, only: &
-    PI, &
-    math_axisAngleToR, &
-    math_sym3333to66, &
-    math_66toSym3333, &
-    math_rotate_forward3333
  
   integer,     dimension(:),            intent(in) :: Ntwin                                         !< number of active twin systems per family
   character(len=*),                     intent(in) :: structure                                     !< lattice structure
@@ -1125,17 +1099,6 @@ end function lattice_C66_twin
 !--------------------------------------------------------------------------------------------------
 function lattice_C66_trans(Ntrans,C_parent66,structure_target, &
                            CoverA_trans,a_bcc,a_fcc)
-  use prec, only: &
-   tol_math_check
-  use IO, only: &
-    IO_error
-  use math, only: &
-    INRAD, &
-    MATH_I3, &
-    math_axisAngleToR, &
-    math_sym3333to66, &
-    math_66toSym3333, &
-    math_rotate_forward3333
  
   integer,     dimension(:),             intent(in) :: Ntrans                                       !< number of active twin systems per family
   character(len=*),                      intent(in) :: structure_target                             !< lattice structure
@@ -1196,13 +1159,6 @@ function lattice_C66_trans(Ntrans,C_parent66,structure_target, &
 ! Gröger et al. 2008, Acta Materialia 56 (2008) 5412–5425, table 1
 !--------------------------------------------------------------------------------------------------
 function lattice_nonSchmidMatrix(Nslip,nonSchmidCoefficients,sense) result(nonSchmidMatrix)
-  use IO, only: &
-    IO_error
-  use math, only: &
-    INRAD, &
-    math_outer, &
-    math_cross, &
-    math_axisAngleToR
 
   integer,     dimension(:),                intent(in) :: Nslip                                     !< number of active slip systems per family
   real(pReal), dimension(:),                intent(in) :: nonSchmidCoefficients                     !< non-Schmid coefficients for projections
@@ -1246,9 +1202,7 @@ end function lattice_nonSchmidMatrix
 !> details only active slip systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_SlipBySlip(Nslip,interactionValues,structure) result(interactionMatrix)
-  use IO, only: &
+
-    IO_error
- 
   integer,         dimension(:),                   intent(in) :: Nslip                              !< number of active slip systems per family
   real(pReal),     dimension(:),                   intent(in) :: interactionValues                  !< values for slip-slip interaction
   character(len=*),                                intent(in) :: structure                          !< lattice structure
@@ -1468,8 +1422,6 @@ end function lattice_interaction_SlipBySlip
 !> details only active twin systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_TwinByTwin(Ntwin,interactionValues,structure) result(interactionMatrix)
-  use IO, only: &
-    IO_error
  
   integer,         dimension(:),                   intent(in) :: Ntwin                              !< number of active twin systems per family
   real(pReal),     dimension(:),                   intent(in) :: interactionValues                  !< values for twin-twin interaction
@@ -1571,8 +1523,6 @@ end function lattice_interaction_TwinByTwin
 !> details only active trans systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_TransByTrans(Ntrans,interactionValues,structure) result(interactionMatrix)
-  use IO, only: &
-    IO_error
  
   integer,         dimension(:),                     intent(in) :: Ntrans                           !< number of active trans systems per family
   real(pReal),     dimension(:),                     intent(in) :: interactionValues                !< values for trans-trans interaction
@@ -1618,8 +1568,6 @@ end function lattice_interaction_TransByTrans
 !> details only active slip and twin systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_SlipByTwin(Nslip,Ntwin,interactionValues,structure) result(interactionMatrix)
-  use IO, only: &
-    IO_error
  
   integer,         dimension(:),                   intent(in) :: Nslip, &                           !< number of active slip systems per family
                                                                  Ntwin                              !< number of active twin systems per family
@@ -1760,8 +1708,6 @@ end function lattice_interaction_SlipByTwin
 !> details only active slip and trans systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structure) result(interactionMatrix)
-  use IO, only: &
-    IO_error
  
   integer,         dimension(:),                    intent(in) :: Nslip, &                          !< number of active slip systems per family
                                                                   Ntrans                            !< number of active trans systems per family
@@ -1818,8 +1764,6 @@ function lattice_interaction_SlipByTrans(Nslip,Ntrans,interactionValues,structur
 !> details only active twin and slip systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_interaction_TwinBySlip(Ntwin,Nslip,interactionValues,structure) result(interactionMatrix)
-  use IO, only: &
-    IO_error
  
   integer,         dimension(:),                   intent(in) :: Ntwin, &                           !< number of active twin systems per family
                                                                  Nslip                              !< number of active slip systems per family
@@ -1898,13 +1842,6 @@ end function lattice_interaction_TwinBySlip
 !> details only active slip systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_SchmidMatrix_slip(Nslip,structure,cOverA) result(SchmidMatrix)
-  use prec, only: &
-    tol_math_check
-  use IO, only: &
-    IO_error
-  use math, only: &
-    math_trace33, &
-    math_outer
  
   integer,         dimension(:),            intent(in) :: Nslip                                     !< number of active slip systems per family
   character(len=*),                         intent(in) :: structure                                 !< lattice structure
@@ -1957,13 +1894,6 @@ end function lattice_SchmidMatrix_slip
 !> details only active twin systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix)
-  use prec, only: &
-    tol_math_check
-  use IO, only: &
-    IO_error
-  use math, only: &
-    math_trace33, &
-    math_outer
  
   integer,         dimension(:),            intent(in) :: Ntwin                                     !< number of active twin systems per family
   character(len=*),                         intent(in) :: structure                                 !< lattice structure
@@ -2013,8 +1943,6 @@ function lattice_SchmidMatrix_twin(Ntwin,structure,cOverA) result(SchmidMatrix)
 !> details only active twin systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_SchmidMatrix_trans(Ntrans,structure_target,cOverA,a_bcc,a_fcc) result(SchmidMatrix)
-  use IO, only: &
-    IO_error
  
   integer,         dimension(:),             intent(in) :: Ntrans                                   !< number of active twin systems per family
   real(pReal),                               intent(in) :: cOverA                                   !< c/a ratio
@@ -2041,11 +1969,7 @@ end function lattice_SchmidMatrix_trans
 !> details only active cleavage systems are considered
 !--------------------------------------------------------------------------------------------------
 function lattice_SchmidMatrix_cleavage(Ncleavage,structure,cOverA) result(SchmidMatrix)
-  use math, only: &
+
-    math_outer
-  use IO, only: &
-    IO_error
- 
   integer,         dimension(:),                  intent(in) :: Ncleavage                           !< number of active cleavage systems per family
   character(len=*),                               intent(in) :: structure                           !< lattice structure
   real(pReal),                                    intent(in) :: cOverA                              !< c/a ratio
@@ -2154,8 +2078,6 @@ end function lattice_slip_transverse
 !> @details: This projection is used to calculate forest hardening for edge dislocations
 !--------------------------------------------------------------------------------------------------
 function slipProjection_transverse(Nslip,structure,cOverA) result(projection)
-  use math, only: &
-    math_inner
  
   integer,         dimension(:),                   intent(in) :: Nslip                              !< number of active slip systems per family
   character(len=*),                                intent(in) :: structure                          !< lattice structure
@@ -2179,8 +2101,6 @@ end function slipProjection_transverse
 !> @details: This projection is used to calculate forest hardening for screw dislocations
 !--------------------------------------------------------------------------------------------------
 function slipProjection_direction(Nslip,structure,cOverA) result(projection)
-  use math, only: &
-    math_inner
  
   integer,         dimension(:),                   intent(in) :: Nslip                              !< number of active slip systems per family
   character(len=*),                                intent(in) :: structure                          !< lattice structure
@@ -2204,9 +2124,7 @@ end function slipProjection_direction
 !> @details Order: Direction, plane (normal), and common perpendicular
 !--------------------------------------------------------------------------------------------------
 function coordinateSystem_slip(Nslip,structure,cOverA) result(coordinateSystem)
-  use IO, only: &
+
-    IO_error
- 
   integer,          dimension(:),            intent(in) :: Nslip                                    !< number of active slip systems per family
   character(len=*),                          intent(in) :: structure                                !< lattice structure
   real(pReal),                               intent(in) :: cOverA                                   !< c/a ratio
@@ -2249,8 +2167,6 @@ end function coordinateSystem_slip
 !> @brief Populates reduced interaction matrix
 !--------------------------------------------------------------------------------------------------
 function buildInteraction(reacting_used,acting_used,reacting_max,acting_max,values,matrix)
-   use IO, only: &
-     IO_error
   
    integer,     dimension(:),                                 intent(in) :: &
       reacting_used, &                                                                              !< # of reacting systems per family as specified in material.config
@@ -2295,10 +2211,6 @@ end function buildInteraction
 !> @details Order: Direction, plane (normal), and common perpendicular
 !--------------------------------------------------------------------------------------------------
 function buildCoordinateSystem(active,complete,system,structure,cOverA)
-  use IO, only: &
-    IO_error
-  use math, only: &
-    math_cross
  
   integer, dimension(:), intent(in) :: &
     active, &
@@ -2370,16 +2282,6 @@ end function buildCoordinateSystem
 !           set a_bcc = 0.0 for fcc -> hex transformation
 !--------------------------------------------------------------------------------------------------
 subroutine buildTransformationSystem(Q,S,Ntrans,cOverA,a_fcc,a_bcc)
-  use prec, only: &
-    dEq0
-  use math, only: &
-    math_cross, &
-    math_outer, &
-    math_axisAngleToR, &
-    INRAD, &
-    MATH_I3
-  use IO, only: &
-    IO_error
  
   integer, dimension(:), intent(in) :: &
     Ntrans

src/list.f90

@@ -3,8 +3,8 @@
 !> @brief linked list
 !--------------------------------------------------------------------------------------------------
 module list
-  use prec, only: &
+  use prec
-    pReal
+  use IO
  
   implicit none
   private 
@@ -65,10 +65,6 @@ contains
 !! to lower case. The data is not stored in the new element but in the current.
 !--------------------------------------------------------------------------------------------------
 subroutine add(this,string)
-  use IO, only: &
-    IO_isBlank, &
-    IO_lc, &
-    IO_stringPos
 
   class(tPartitionedStringList),  target, intent(in) :: this
   character(len=*),                       intent(in) :: string
@@ -157,8 +153,6 @@ end subroutine finalizeArray
 !> @brief reports wether a given key (string value at first position) exists in the list
 !--------------------------------------------------------------------------------------------------
 logical function keyExists(this,key)
-  use IO, only: &
-    IO_stringValue
 
   class(tPartitionedStringList), target, intent(in) :: this
   character(len=*),                      intent(in) :: key
@@ -180,8 +174,6 @@ end function keyExists
 !> @details traverses list and counts each occurrence of specified key
 !--------------------------------------------------------------------------------------------------
 integer function countKeys(this,key)
-  use IO, only: &
-    IO_stringValue
 
   class(tPartitionedStringList), target, intent(in) :: this
   character(len=*),                      intent(in) :: key
@@ -205,10 +197,6 @@ end function countKeys
 !! error unless default is given
 !--------------------------------------------------------------------------------------------------
 real(pReal) function getFloat(this,key,defaultVal)
-  use IO, only : &
-    IO_error, &
-    IO_stringValue, &
-    IO_FloatValue
 
   class(tPartitionedStringList), target, intent(in)           :: this
   character(len=*),                      intent(in)           :: key
@@ -241,10 +229,6 @@ end function getFloat
 !! error unless default is given
 !--------------------------------------------------------------------------------------------------
 integer function getInt(this,key,defaultVal)
-  use IO, only: &
-    IO_error, &
-    IO_stringValue, &
-    IO_IntValue
 
   class(tPartitionedStringList), target, intent(in)           :: this
   character(len=*),                      intent(in)           :: key
@@ -278,9 +262,6 @@ end function getInt
 !! the individual chunks are returned
 !--------------------------------------------------------------------------------------------------
 character(len=65536) function getString(this,key,defaultVal,raw)
-  use IO, only: &
-    IO_error, &
-    IO_stringValue
  
   class(tPartitionedStringList), target, intent(in)           :: this
   character(len=*),                      intent(in)           :: key
@@ -327,10 +308,6 @@ end function getString
 !! values from the last occurrence. If key is not found exits with error unless default is given.
 !--------------------------------------------------------------------------------------------------
 function getFloats(this,key,defaultVal,requiredSize)
-  use IO, only: &
-    IO_error, &
-    IO_stringValue, &
-    IO_FloatValue
  
   real(pReal),     dimension(:), allocatable          :: getFloats
   class(tPartitionedStringList), target, intent(in)   :: this
@@ -376,10 +353,6 @@ end function getFloats
 !! values from the last occurrence. If key is not found exits with error unless default is given.
 !--------------------------------------------------------------------------------------------------
 function getInts(this,key,defaultVal,requiredSize)
-  use IO, only: &
-    IO_error, &
-    IO_stringValue, &
-    IO_IntValue
  
   integer, dimension(:), allocatable                          :: getInts
   class(tPartitionedStringList), target, intent(in)           :: this
@@ -426,9 +399,6 @@ end function getInts
 !! If raw is true, the the complete string is returned, otherwise the individual chunks are returned
 !--------------------------------------------------------------------------------------------------
 function getStrings(this,key,defaultVal,raw)
-  use IO, only: &
-    IO_error, &
-    IO_StringValue
  
   character(len=65536),dimension(:), allocatable             :: getStrings
   class(tPartitionedStringList),target, intent(in)           :: this

src/material.f90

@@ -47,55 +47,35 @@ module material
 
  enum, bind(c)
    enumerator :: ELASTICITY_undefined_ID, &
-                 ELASTICITY_hooke_ID
+                 ELASTICITY_hooke_ID, &
- end enum
+                 PLASTICITY_undefined_ID, &
- enum, bind(c)
-   enumerator :: PLASTICITY_undefined_ID, &
                  PLASTICITY_none_ID, &
                  PLASTICITY_isotropic_ID, &
                  PLASTICITY_phenopowerlaw_ID, &
                  PLASTICITY_kinehardening_ID, &
                  PLASTICITY_dislotwin_ID, &
                  PLASTICITY_disloucla_ID, &
-                 PLASTICITY_nonlocal_ID
+                 PLASTICITY_nonlocal_ID, &
- end enum
+                 SOURCE_undefined_ID, &
-
- enum, bind(c)
-   enumerator :: SOURCE_undefined_ID, &
                  SOURCE_thermal_dissipation_ID, &
                  SOURCE_thermal_externalheat_ID, &
                  SOURCE_damage_isoBrittle_ID, &
                  SOURCE_damage_isoDuctile_ID, &
                  SOURCE_damage_anisoBrittle_ID, &
-                 SOURCE_damage_anisoDuctile_ID
+                 SOURCE_damage_anisoDuctile_ID, &
- end enum
+                 KINEMATICS_undefined_ID, &
-
- enum, bind(c)
-   enumerator :: KINEMATICS_undefined_ID, &
                  KINEMATICS_cleavage_opening_ID, &
                  KINEMATICS_slipplane_opening_ID, &
-                 KINEMATICS_thermal_expansion_ID
+                 KINEMATICS_thermal_expansion_ID, &
- end enum
+                 STIFFNESS_DEGRADATION_undefined_ID, &
-
+                 STIFFNESS_DEGRADATION_damage_ID, &
- enum, bind(c)
+                 THERMAL_isothermal_ID, &
-   enumerator :: STIFFNESS_DEGRADATION_undefined_ID, &
-                 STIFFNESS_DEGRADATION_damage_ID
- end enum
-
- enum, bind(c)
-   enumerator :: THERMAL_isothermal_ID, &
                  THERMAL_adiabatic_ID, &
-                 THERMAL_conduction_ID
+                 THERMAL_conduction_ID, &
- end enum
+                 DAMAGE_none_ID, &
-
- enum, bind(c)
-   enumerator :: DAMAGE_none_ID, &
                  DAMAGE_local_ID, &
-                 DAMAGE_nonlocal_ID
+                 DAMAGE_nonlocal_ID, &
- end enum
+                 HOMOGENIZATION_undefined_ID, &
-
- enum, bind(c)
-   enumerator :: HOMOGENIZATION_undefined_ID, &
                  HOMOGENIZATION_none_ID, &
                  HOMOGENIZATION_isostrain_ID, &
                  HOMOGENIZATION_rgc_ID
@@ -118,10 +98,10 @@ module material
  integer(kind(HOMOGENIZATION_undefined_ID)), dimension(:),   allocatable, public, protected :: &
    homogenization_type                                                                              !< type of each homogenization
 
- integer(pInt), public, protected :: &
+ integer, public, protected :: &
    homogenization_maxNgrains                                                                        !< max number of grains in any USED homogenization
 
- integer(pInt), dimension(:), allocatable, public, protected :: &
+ integer, dimension(:), allocatable, public, protected :: &
    phase_Nsources, &                                                                                !< number of source mechanisms active in each phase
    phase_Nkinematics, &                                                                             !< number of kinematic mechanisms active in each phase
    phase_NstiffnessDegradations, &                                                                  !< number of stiffness degradation mechanisms active in each phase
@@ -152,7 +132,7 @@ module material
 ! END NEW MAPPINGS
  
 ! DEPRECATED: use material_phaseAt
- integer(pInt), dimension(:,:,:), allocatable, public :: &
+ integer, dimension(:,:,:), allocatable, public :: &
    material_phase                                                                                   !< phase (index) of each grain,IP,element
 
  type(tPlasticState), allocatable, dimension(:), public :: &
@@ -164,7 +144,7 @@ module material
    thermalState, &
    damageState
 
- integer(pInt), dimension(:,:,:), allocatable, public, protected :: &
+ integer, dimension(:,:,:), allocatable, public, protected :: &
    material_texture                                                                                 !< texture (index) of each grain,IP,element
 
  real(pReal), dimension(:,:,:,:), allocatable, public, protected :: &
@@ -175,15 +155,15 @@ module material
    microstructure_elemhomo, &                                                                       !< flag to indicate homogeneous microstructure distribution over element's IPs
    phase_localPlasticity                                                                            !< flags phases with local constitutive law
 
- integer(pInt), private :: &
+ integer, private :: &
    microstructure_maxNconstituents, &                                                               !< max number of constituents in any phase
    texture_maxNgauss                                                                                !< max number of Gauss components in any texture
 
- integer(pInt), dimension(:), allocatable, private :: &
+ integer, dimension(:), allocatable, private :: &
    microstructure_Nconstituents, &                                                                  !< number of constituents in each microstructure
    texture_Ngauss                                                                                   !< number of Gauss components per texture
 
- integer(pInt), dimension(:,:), allocatable, private :: &
+ integer, dimension(:,:), allocatable, private :: &
    microstructure_phase, &                                                                          !< phase IDs of each microstructure
    microstructure_texture                                                                           !< texture IDs of each microstructure
 
@@ -198,11 +178,11 @@ module material
    homogenization_active
 
 ! BEGIN DEPRECATED
- integer(pInt), dimension(:,:,:), allocatable, public :: phaseAt                                    !< phase ID of every material point (ipc,ip,el)
+ integer, dimension(:,:,:), allocatable, public :: phaseAt                                          !< phase ID of every material point (ipc,ip,el)
- integer(pInt), dimension(:,:,:), allocatable, public :: phasememberAt                              !< memberID of given phase at every material point (ipc,ip,el)
+ integer, dimension(:,:,:), allocatable, public :: phasememberAt                                    !< memberID of given phase at every material point (ipc,ip,el)
 
- integer(pInt), dimension(:,:,:), allocatable, public, target :: mappingHomogenization              !< mapping from material points to offset in heterogenous state/field
+ integer, dimension(:,:,:), allocatable, public, target :: mappingHomogenization                    !< mapping from material points to offset in heterogenous state/field
- integer(pInt), dimension(:,:),   allocatable, private, target :: mappingHomogenizationConst         !< mapping from material points to offset in constant state/field
+ integer, dimension(:,:),   allocatable, private, target :: mappingHomogenizationConst               !< mapping from material points to offset in constant state/field
 ! END DEPRECATED
 
  type(tHomogMapping), allocatable, dimension(:), public :: &
@@ -276,13 +256,13 @@ subroutine material_init
  use mesh, only: &
    theMesh
 
- integer(pInt), parameter :: FILEUNIT = 210_pInt
+ integer, parameter :: FILEUNIT = 210
- integer(pInt)            :: m,c,h, myDebug, myPhase, myHomog
+ integer            :: m,c,h, myDebug, myPhase, myHomog
- integer(pInt) :: &
+ integer :: &
   g, &                                                                                              !< grain number
   i, &                                                                                              !< integration point number
   e                                                                                                 !< element number
- integer(pInt), dimension(:), allocatable :: &
+ integer, dimension(:), allocatable :: &
   CounterPhase, &
   CounterHomogenization
 
@@ -291,19 +271,19 @@ subroutine material_init
  write(6,'(/,a)') ' <<<+-  material init  -+>>>'
 
  call material_parsePhase()
- if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase          parsed'; flush(6)
+ if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Phase          parsed'; flush(6)
  
  call material_parseMicrostructure()
- if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6)
+ if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Microstructure parsed'; flush(6)
  
  call material_parseCrystallite()
- if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite    parsed'; flush(6)
+ if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Crystallite    parsed'; flush(6)
  
  call material_parseHomogenization()
- if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6)
+ if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Homogenization parsed'; flush(6)
  
  call material_parseTexture()
- if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture        parsed'; flush(6)
+ if (iand(myDebug,debug_levelBasic) /= 0) write(6,'(a)') ' Texture        parsed'; flush(6)
 
  allocate(plasticState       (size(config_phase)))
  allocate(sourceState        (size(config_phase)))
@@ -323,34 +303,34 @@ subroutine material_init
 
  allocate(temperatureRate    (size(config_homogenization)))
 
- do m = 1_pInt,size(config_microstructure)
+ do m = 1,size(config_microstructure)
-   if(microstructure_crystallite(m) < 1_pInt .or. &
+   if(microstructure_crystallite(m) < 1 .or. &
       microstructure_crystallite(m) > size(config_crystallite)) &
-        call IO_error(150_pInt,m,ext_msg='crystallite')
+        call IO_error(150,m,ext_msg='crystallite')
-   if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. &
+   if(minval(microstructure_phase(1:microstructure_Nconstituents(m),m)) < 1 .or. &
       maxval(microstructure_phase(1:microstructure_Nconstituents(m),m)) > size(config_phase)) &
-        call IO_error(150_pInt,m,ext_msg='phase')
+        call IO_error(150,m,ext_msg='phase')
-   if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1_pInt .or. &
+   if(minval(microstructure_texture(1:microstructure_Nconstituents(m),m)) < 1 .or. &
       maxval(microstructure_texture(1:microstructure_Nconstituents(m),m)) > size(config_texture)) &
-        call IO_error(150_pInt,m,ext_msg='texture')
+        call IO_error(150,m,ext_msg='texture')
-   if(microstructure_Nconstituents(m) < 1_pInt) &
+   if(microstructure_Nconstituents(m) < 1) &
-        call IO_error(151_pInt,m)
+        call IO_error(151,m)
  enddo
 
- debugOut: if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then
+ debugOut: if (iand(myDebug,debug_levelExtensive) /= 0) then
    write(6,'(/,a,/)') ' MATERIAL configuration'
    write(6,'(a32,1x,a16,1x,a6)') 'homogenization                  ','type            ','grains'
-   do h = 1_pInt,size(config_homogenization)
+   do h = 1,size(config_homogenization)
      write(6,'(1x,a32,1x,a16,1x,i6)') homogenization_name(h),homogenization_type(h),homogenization_Ngrains(h)
    enddo
    write(6,'(/,a14,18x,1x,a11,1x,a12,1x,a13)') 'microstructure','crystallite','constituents','homogeneous'
-   do m = 1_pInt,size(config_microstructure)
+   do m = 1,size(config_microstructure)
      write(6,'(1x,a32,1x,i11,1x,i12,1x,l13)') microstructure_name(m), &
                                         microstructure_crystallite(m), &
                                         microstructure_Nconstituents(m), &
                                         microstructure_elemhomo(m)
-     if (microstructure_Nconstituents(m) > 0_pInt) then
+     if (microstructure_Nconstituents(m) > 0) then
-       do c = 1_pInt,microstructure_Nconstituents(m)
+       do c = 1,microstructure_Nconstituents(m)
          write(6,'(a1,1x,a32,1x,a32,1x,f7.4)') '>',phase_name(microstructure_phase(c,m)),&
                                                    texture_name(microstructure_texture(c,m)),&
                                                    microstructure_fraction(c,m)
@@ -403,23 +383,23 @@ subroutine material_init
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 ! BEGIN DEPRECATED
- allocate(phaseAt                   (  homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt)
+ allocate(phaseAt                   (  homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
- allocate(phasememberAt             (  homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt)
+ allocate(phasememberAt             (  homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0)
- allocate(mappingHomogenization     (2,                          theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt)
+ allocate(mappingHomogenization     (2,                          theMesh%elem%nIPs,theMesh%Nelems),source=0)
- allocate(mappingHomogenizationConst(                            theMesh%elem%nIPs,theMesh%Nelems),source=1_pInt)
+ allocate(mappingHomogenizationConst(                            theMesh%elem%nIPs,theMesh%Nelems),source=1)
  
  CounterHomogenization=0
  CounterPhase         =0
 
 
- do e = 1_pInt,theMesh%Nelems
+ do e = 1,theMesh%Nelems
  myHomog = theMesh%homogenizationAt(e)
-   do i = 1_pInt, theMesh%elem%nIPs
+   do i = 1, theMesh%elem%nIPs
-     CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt
+     CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1
      mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),huge(1)]
-     do g = 1_pInt,homogenization_Ngrains(myHomog)
+     do g = 1,homogenization_Ngrains(myHomog)
        myPhase = material_phase(g,i,e)
-       CounterPhase(myPhase) = CounterPhase(myPhase)+1_pInt                             ! not distinguishing between instances of same phase
+       CounterPhase(myPhase) = CounterPhase(myPhase)+1                             ! not distinguishing between instances of same phase
        phaseAt(g,i,e)              = myPhase
        phasememberAt(g,i,e)        = CounterPhase(myPhase)
      enddo
@@ -449,33 +429,33 @@ subroutine material_parseHomogenization
  use IO, only: &
    IO_error
 
- integer(pInt)        :: h
+ integer              :: h
  character(len=65536) :: tag
 
  allocate(homogenization_type(size(config_homogenization)),           source=HOMOGENIZATION_undefined_ID)
  allocate(thermal_type(size(config_homogenization)),                  source=THERMAL_isothermal_ID)
  allocate(damage_type (size(config_homogenization)),                  source=DAMAGE_none_ID)
- allocate(homogenization_typeInstance(size(config_homogenization)),   source=0_pInt)
+ allocate(homogenization_typeInstance(size(config_homogenization)),   source=0)
- allocate(thermal_typeInstance(size(config_homogenization)),          source=0_pInt)
+ allocate(thermal_typeInstance(size(config_homogenization)),          source=0)
- allocate(damage_typeInstance(size(config_homogenization)),           source=0_pInt)
+ allocate(damage_typeInstance(size(config_homogenization)),           source=0)
- allocate(homogenization_Ngrains(size(config_homogenization)),        source=0_pInt)
+ allocate(homogenization_Ngrains(size(config_homogenization)),        source=0)
- allocate(homogenization_Noutput(size(config_homogenization)),        source=0_pInt)
+ allocate(homogenization_Noutput(size(config_homogenization)),        source=0)
  allocate(homogenization_active(size(config_homogenization)),         source=.false.)  !!!!!!!!!!!!!!!
  allocate(thermal_initialT(size(config_homogenization)),              source=300.0_pReal)
  allocate(damage_initialPhi(size(config_homogenization)),             source=1.0_pReal)
 
- forall (h = 1_pInt:size(config_homogenization)) &
+ forall (h = 1:size(config_homogenization)) &
    homogenization_active(h) = any(theMesh%homogenizationAt == h)
 
 
- do h=1_pInt, size(config_homogenization)
+ do h=1, size(config_homogenization)
    homogenization_Noutput(h) = config_homogenization(h)%countKeys('(output)')
 
    tag = config_homogenization(h)%getString('mech')
    select case (trim(tag))
      case(HOMOGENIZATION_NONE_label)
        homogenization_type(h) = HOMOGENIZATION_NONE_ID
-       homogenization_Ngrains(h) = 1_pInt
+       homogenization_Ngrains(h) = 1
      case(HOMOGENIZATION_ISOSTRAIN_label)
        homogenization_type(h) = HOMOGENIZATION_ISOSTRAIN_ID
        homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents')
@@ -483,7 +463,7 @@ subroutine material_parseHomogenization
        homogenization_type(h) = HOMOGENIZATION_RGC_ID
        homogenization_Ngrains(h) = config_homogenization(h)%getInt('nconstituents')
      case default
-       call IO_error(500_pInt,ext_msg=trim(tag))
+       call IO_error(500,ext_msg=trim(tag))
    end select
    
    homogenization_typeInstance(h) = count(homogenization_type==homogenization_type(h))
@@ -500,7 +480,7 @@ subroutine material_parseHomogenization
        case(THERMAL_conduction_label)
          thermal_type(h) = THERMAL_conduction_ID
        case default
-         call IO_error(500_pInt,ext_msg=trim(tag))
+         call IO_error(500,ext_msg=trim(tag))
      end select
 
    endif
@@ -517,14 +497,14 @@ subroutine material_parseHomogenization
        case(DAMAGE_NONLOCAL_label)
          damage_type(h) = DAMAGE_nonlocal_ID
        case default
-         call IO_error(500_pInt,ext_msg=trim(tag))
+         call IO_error(500,ext_msg=trim(tag))
      end select
 
    endif
 
  enddo
 
- do h=1_pInt, size(config_homogenization)
+ do h=1, size(config_homogenization)
    homogenization_typeInstance(h)  = count(homogenization_type(1:h)  == homogenization_type(h))
    thermal_typeInstance(h)         = count(thermal_type       (1:h)  == thermal_type       (h))
    damage_typeInstance(h)          = count(damage_type        (1:h)  == damage_type        (h))
@@ -550,58 +530,58 @@ subroutine material_parseMicrostructure
 
  character(len=65536), dimension(:), allocatable :: &
    strings
- integer(pInt), allocatable, dimension(:) :: chunkPos
+ integer, allocatable, dimension(:) :: chunkPos
- integer(pInt) :: e, m, c, i
+ integer :: e, m, c, i
  character(len=65536) :: &
    tag
 
- allocate(microstructure_crystallite(size(config_microstructure)),          source=0_pInt)
+ allocate(microstructure_crystallite(size(config_microstructure)),          source=0)
- allocate(microstructure_Nconstituents(size(config_microstructure)),        source=0_pInt)
+ allocate(microstructure_Nconstituents(size(config_microstructure)),        source=0)
  allocate(microstructure_active(size(config_microstructure)),               source=.false.)
  allocate(microstructure_elemhomo(size(config_microstructure)),             source=.false.)
 
  if(any(theMesh%microstructureAt > size(config_microstructure))) &
-  call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config')
+  call IO_error(155,ext_msg='More microstructures in geometry than sections in material.config')
 
- forall (e = 1_pInt:theMesh%Nelems) &
+ forall (e = 1:theMesh%Nelems) &
    microstructure_active(theMesh%microstructureAt(e)) = .true.                                         ! current microstructure used in model? Elementwise view, maximum N operations for N elements
 
- do m=1_pInt, size(config_microstructure)
+ do m=1, size(config_microstructure)
    microstructure_Nconstituents(m) =  config_microstructure(m)%countKeys('(constituent)')
    microstructure_crystallite(m)   =  config_microstructure(m)%getInt('crystallite')
    microstructure_elemhomo(m)      =  config_microstructure(m)%keyExists('/elementhomogeneous/')
  enddo
 
  microstructure_maxNconstituents = maxval(microstructure_Nconstituents)
- allocate(microstructure_phase   (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt)
+ allocate(microstructure_phase   (microstructure_maxNconstituents,size(config_microstructure)),source=0)
- allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0_pInt)
+ allocate(microstructure_texture (microstructure_maxNconstituents,size(config_microstructure)),source=0)
  allocate(microstructure_fraction(microstructure_maxNconstituents,size(config_microstructure)),source=0.0_pReal)
 
  allocate(strings(1))                                                                               ! Intel 16.0 Bug
- do m=1_pInt, size(config_microstructure)
+ do m=1, size(config_microstructure)
    strings = config_microstructure(m)%getStrings('(constituent)',raw=.true.)
-   do c = 1_pInt, size(strings)
+   do c = 1, size(strings)
      chunkPos = IO_stringPos(strings(c))
 
-     do i = 1_pInt,5_pInt,2_pInt
+     do i = 1,5,2
         tag = IO_stringValue(strings(c),chunkPos,i)
 
         select case (tag)
           case('phase')
-            microstructure_phase(c,m) =    IO_intValue(strings(c),chunkPos,i+1_pInt)
+            microstructure_phase(c,m) =    IO_intValue(strings(c),chunkPos,i+1)
           case('texture')
-            microstructure_texture(c,m) =  IO_intValue(strings(c),chunkPos,i+1_pInt)
+            microstructure_texture(c,m) =  IO_intValue(strings(c),chunkPos,i+1)
           case('fraction')
-            microstructure_fraction(c,m) =  IO_floatValue(strings(c),chunkPos,i+1_pInt)
+            microstructure_fraction(c,m) =  IO_floatValue(strings(c),chunkPos,i+1)
         end select
      
      enddo
    enddo
  enddo
 
- do m = 1_pInt, size(config_microstructure)
+ do m = 1, size(config_microstructure)
    if (dNeq(sum(microstructure_fraction(:,m)),1.0_pReal)) &
-     call IO_error(153_pInt,ext_msg=microstructure_name(m))
+     call IO_error(153,ext_msg=microstructure_name(m))
  enddo
  
 end subroutine material_parseMicrostructure
@@ -612,10 +592,10 @@ end subroutine material_parseMicrostructure
 !--------------------------------------------------------------------------------------------------
 subroutine material_parseCrystallite
 
- integer(pInt)        :: c
+ integer        :: c
 
- allocate(crystallite_Noutput(size(config_crystallite)),source=0_pInt)
+ allocate(crystallite_Noutput(size(config_crystallite)),source=0)
- do c=1_pInt, size(config_crystallite)
+ do c=1, size(config_crystallite)
    crystallite_Noutput(c) =  config_crystallite(c)%countKeys('(output)')
  enddo
 
@@ -631,19 +611,19 @@ subroutine material_parsePhase
    IO_getTag, &
    IO_stringValue
 
- integer(pInt) :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
+ integer :: sourceCtr, kinematicsCtr, stiffDegradationCtr, p
  character(len=65536), dimension(:), allocatable ::  str 
 
 
  allocate(phase_elasticity(size(config_phase)),source=ELASTICITY_undefined_ID)
  allocate(phase_plasticity(size(config_phase)),source=PLASTICITY_undefined_ID)
- allocate(phase_Nsources(size(config_phase)),              source=0_pInt)
+ allocate(phase_Nsources(size(config_phase)),              source=0)
- allocate(phase_Nkinematics(size(config_phase)),           source=0_pInt)
+ allocate(phase_Nkinematics(size(config_phase)),           source=0)
- allocate(phase_NstiffnessDegradations(size(config_phase)),source=0_pInt)
+ allocate(phase_NstiffnessDegradations(size(config_phase)),source=0)
- allocate(phase_Noutput(size(config_phase)),               source=0_pInt)
+ allocate(phase_Noutput(size(config_phase)),               source=0)
  allocate(phase_localPlasticity(size(config_phase)),       source=.false.)
 
- do p=1_pInt, size(config_phase)
+ do p=1, size(config_phase)
    phase_Noutput(p) =                 config_phase(p)%countKeys('(output)')
    phase_Nsources(p) =                config_phase(p)%countKeys('(source)')
    phase_Nkinematics(p) =             config_phase(p)%countKeys('(kinematics)')
@@ -654,7 +634,7 @@ subroutine material_parsePhase
      case (ELASTICITY_HOOKE_label)
        phase_elasticity(p) = ELASTICITY_HOOKE_ID
      case default
-       call IO_error(200_pInt,ext_msg=trim(config_phase(p)%getString('elasticity')))
+       call IO_error(200,ext_msg=trim(config_phase(p)%getString('elasticity')))
    end select
 
    select case (config_phase(p)%getString('plasticity'))
@@ -673,7 +653,7 @@ subroutine material_parsePhase
      case (PLASTICITY_NONLOCAL_label)
        phase_plasticity(p) = PLASTICITY_NONLOCAL_ID
      case default
-       call IO_error(201_pInt,ext_msg=trim(config_phase(p)%getString('plasticity')))
+       call IO_error(201,ext_msg=trim(config_phase(p)%getString('plasticity')))
    end select
 
  enddo
@@ -682,7 +662,7 @@ subroutine material_parsePhase
  allocate(phase_kinematics(maxval(phase_Nkinematics),size(config_phase)), source=KINEMATICS_undefined_ID)
  allocate(phase_stiffnessDegradation(maxval(phase_NstiffnessDegradations),size(config_phase)), &
           source=STIFFNESS_DEGRADATION_undefined_ID)
- do p=1_pInt, size(config_phase)
+ do p=1, size(config_phase)
 #if defined(__GFORTRAN__) || defined(__PGI)
    str = ['GfortranBug86277']
    str = config_phase(p)%getStrings('(source)',defaultVal=str)
@@ -690,7 +670,7 @@ subroutine material_parsePhase
 #else
    str = config_phase(p)%getStrings('(source)',defaultVal=[character(len=65536)::])
 #endif
-   do sourceCtr = 1_pInt, size(str)
+   do sourceCtr = 1, size(str)
      select case (trim(str(sourceCtr)))
        case (SOURCE_thermal_dissipation_label)
          phase_source(sourceCtr,p) = SOURCE_thermal_dissipation_ID
@@ -714,7 +694,7 @@ subroutine material_parsePhase
 #else
    str = config_phase(p)%getStrings('(kinematics)',defaultVal=[character(len=65536)::])
 #endif
-   do kinematicsCtr = 1_pInt, size(str)
+   do kinematicsCtr = 1, size(str)
      select case (trim(str(kinematicsCtr)))
        case (KINEMATICS_cleavage_opening_label)
          phase_kinematics(kinematicsCtr,p) = KINEMATICS_cleavage_opening_ID
@@ -731,7 +711,7 @@ subroutine material_parsePhase
 #else
    str = config_phase(p)%getStrings('(stiffness_degradation)',defaultVal=[character(len=65536)::])
 #endif
-   do stiffDegradationCtr = 1_pInt, size(str)
+   do stiffDegradationCtr = 1, size(str)
      select case (trim(str(stiffDegradationCtr)))
        case (STIFFNESS_DEGRADATION_damage_label)
          phase_stiffnessDegradation(stiffDegradationCtr,p) = STIFFNESS_DEGRADATION_damage_ID
@@ -739,10 +719,10 @@ subroutine material_parsePhase
    enddo
  enddo
 
- allocate(phase_plasticityInstance(size(config_phase)),   source=0_pInt)
+ allocate(phase_plasticityInstance(size(config_phase)),   source=0)
- allocate(phase_elasticityInstance(size(config_phase)),   source=0_pInt)
+ allocate(phase_elasticityInstance(size(config_phase)),   source=0)
 
- do p=1_pInt, size(config_phase)
+ do p=1, size(config_phase)
    phase_elasticityInstance(p)  = count(phase_elasticity(1:p)  == phase_elasticity(p))
    phase_plasticityInstance(p)  = count(phase_plasticity(1:p)  == phase_plasticity(p))
  enddo
@@ -759,13 +739,13 @@ subroutine material_parseTexture
    IO_floatValue, &
    IO_stringValue
 
- integer(pInt) :: section, gauss, j, t, i
+ integer :: section, gauss, j, t, i
  character(len=65536), dimension(:), allocatable ::  strings                                     ! Values for given key in material config 
- integer(pInt), dimension(:), allocatable :: chunkPos
+ integer, dimension(:), allocatable :: chunkPos
 
- allocate(texture_Ngauss(size(config_texture)),   source=0_pInt)
+ allocate(texture_Ngauss(size(config_texture)),   source=0)
 
- do t=1_pInt, size(config_texture)
+ do t=1, size(config_texture)
    texture_Ngauss(t) =  config_texture(t)%countKeys('(gauss)')
    if (config_texture(t)%keyExists('symmetry')) call IO_error(147,ext_msg='symmetry')
    if (config_texture(t)%keyExists('(random)')) call IO_error(147,ext_msg='(random)')
@@ -777,13 +757,13 @@ subroutine material_parseTexture
  allocate(texture_transformation(3,3,size(config_texture)),         source=0.0_pReal)
           texture_transformation = spread(math_I3,3,size(config_texture))
 
- do t=1_pInt, size(config_texture)
+ do t=1, size(config_texture)
    section = t
-   gauss = 0_pInt
+   gauss = 0
    
    if (config_texture(t)%keyExists('axes')) then
      strings = config_texture(t)%getStrings('axes')
-     do j = 1_pInt, 3_pInt                                                                          ! look for "x", "y", and "z" entries
+     do j = 1, 3                                                                                    ! look for "x", "y", and "z" entries
        select case (strings(j))
          case('x', '+x')
            texture_transformation(j,1:3,t) = [ 1.0_pReal, 0.0_pReal, 0.0_pReal]                     ! original axis is now +x-axis
@@ -798,25 +778,25 @@ subroutine material_parseTexture
          case('-z')
            texture_transformation(j,1:3,t) = [ 0.0_pReal, 0.0_pReal,-1.0_pReal]                     ! original axis is now -z-axis
          case default
-           call IO_error(157_pInt,t)
+           call IO_error(157,t)
        end select
      enddo
-     if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157_pInt,t)
+     if(dNeq(math_det33(texture_transformation(1:3,1:3,t)),1.0_pReal)) call IO_error(157,t)
    endif
 
    if (config_texture(t)%keyExists('(gauss)')) then
-     gauss = gauss + 1_pInt
+     gauss = gauss + 1
      strings = config_texture(t)%getStrings('(gauss)',raw= .true.)
-     do i = 1_pInt , size(strings)
+     do i = 1 , size(strings)
        chunkPos = IO_stringPos(strings(i))
-       do j = 1_pInt,9_pInt,2_pInt
+       do j = 1,9,2
          select case (IO_stringValue(strings(i),chunkPos,j))
              case('phi1')
-                 texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
+                 texture_Gauss(1,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
              case('phi')
-                 texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
+                 texture_Gauss(2,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
              case('phi2')
-                 texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1_pInt)*inRad
+                 texture_Gauss(3,gauss,t) = IO_floatValue(strings(i),chunkPos,j+1)*inRad
           end select
       enddo
      enddo
@@ -837,7 +817,7 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,&
  use numerics, only: &
    numerics_integrator
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    phase, &
    NofMyPhase, &
    sizeState, &
@@ -862,13 +842,13 @@ subroutine material_allocatePlasticState(phase,NofMyPhase,&
  allocate(plasticState(phase)%state               (sizeState,NofMyPhase),     source=0.0_pReal)
 
  allocate(plasticState(phase)%dotState            (sizeDotState,NofMyPhase),  source=0.0_pReal)
- if (numerics_integrator == 1_pInt) then
+ if (numerics_integrator == 1) then
    allocate(plasticState(phase)%previousDotState  (sizeDotState,NofMyPhase),  source=0.0_pReal)
    allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase),  source=0.0_pReal)
  endif
- if (numerics_integrator == 4_pInt) &
+ if (numerics_integrator == 4) &
    allocate(plasticState(phase)%RK4dotState       (sizeDotState,NofMyPhase),  source=0.0_pReal)
- if (numerics_integrator == 5_pInt) &
+ if (numerics_integrator == 5) &
    allocate(plasticState(phase)%RKCK45dotState  (6,sizeDotState,NofMyPhase),  source=0.0_pReal)
 
  allocate(plasticState(phase)%deltaState        (sizeDeltaState,NofMyPhase),  source=0.0_pReal)
@@ -884,7 +864,7 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,&
  use numerics, only: &
    numerics_integrator
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    phase, &
    of, &
    NofMyPhase, &
@@ -902,13 +882,13 @@ subroutine material_allocateSourceState(phase,of,NofMyPhase,&
  allocate(sourceState(phase)%p(of)%state               (sizeState,NofMyPhase),     source=0.0_pReal)
 
  allocate(sourceState(phase)%p(of)%dotState            (sizeDotState,NofMyPhase),  source=0.0_pReal)
- if (numerics_integrator == 1_pInt) then
+ if (numerics_integrator == 1) then
    allocate(sourceState(phase)%p(of)%previousDotState  (sizeDotState,NofMyPhase),  source=0.0_pReal)
    allocate(sourceState(phase)%p(of)%previousDotState2 (sizeDotState,NofMyPhase),  source=0.0_pReal)
  endif
- if (numerics_integrator == 4_pInt) &
+ if (numerics_integrator == 4) &
    allocate(sourceState(phase)%p(of)%RK4dotState       (sizeDotState,NofMyPhase),  source=0.0_pReal)
- if (numerics_integrator == 5_pInt) &
+ if (numerics_integrator == 5) &
    allocate(sourceState(phase)%p(of)%RKCK45dotState  (6,sizeDotState,NofMyPhase),  source=0.0_pReal)
 
  allocate(sourceState(phase)%p(of)%deltaState        (sizeDeltaState,NofMyPhase),  source=0.0_pReal)
@@ -925,10 +905,10 @@ subroutine material_populateGrains
  use mesh, only: &
    theMesh
 
- integer(pInt) :: e,i,c,homog,micro
+ integer :: e,i,c,homog,micro
 
- allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),        source=0_pInt)
+ allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),        source=0)
- allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),      source=0_pInt)
+ allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),      source=0)
  allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal)
 
   do e = 1, theMesh%Nelems

src/math.f90

@@ -10,12 +10,20 @@ module math
   use future
 
   implicit none
-  real(pReal),    parameter, public :: PI = acos(-1.0_pReal)                                        !< ratio of a circle's circumference to its diameter
+  public
-  real(pReal),    parameter, public :: INDEG = 180.0_pReal/PI                                       !< conversion from radian into degree
+#if __INTEL_COMPILER >= 1900
-  real(pReal),    parameter, public :: INRAD = PI/180.0_pReal                                       !< conversion from degree into radian
+  ! do not make use associated entities available to other modules
-  complex(pReal), parameter, public :: TWOPIIMG = cmplx(0.0_pReal,2.0_pReal*PI)                     !< Re(0.0), Im(2xPi)
+  private :: &
+    prec, &
+    future
+#endif
 
-  real(pReal), dimension(3,3), parameter, public :: &
+  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 :: INRAD = PI/180.0_pReal                                               !< conversion from degree into radian
+  complex(pReal), parameter :: TWOPIIMG = cmplx(0.0_pReal,2.0_pReal*PI)                             !< Re(0.0), Im(2xPi)
+
+  real(pReal), dimension(3,3), parameter :: &
     MATH_I3 = reshape([&
       1.0_pReal,0.0_pReal,0.0_pReal, &
       0.0_pReal,1.0_pReal,0.0_pReal, &
@@ -75,7 +83,7 @@ module math
 !---------------------------------------------------------------------------------------------------
 
  private :: &
-   math_check
+   unitTest
 
 contains
 
@@ -116,14 +124,15 @@ subroutine math_init
   write(6,'(a,4(/,26x,f17.14),/)') ' start of random sequence: ', randTest
 
   call random_seed(put = randInit)
-  call math_check
+  call unitTest
 
 end subroutine math_init
+
  
 !--------------------------------------------------------------------------------------------------
 !> @brief check correctness of (some) math functions
 !--------------------------------------------------------------------------------------------------
-subroutine math_check
+subroutine unitTest
   use IO, only: IO_error
 
   character(len=64) :: error_msg
@@ -145,7 +154,7 @@ subroutine math_check
     call IO_error(401,ext_msg=error_msg)
   endif
  
-end subroutine math_check
+end subroutine unitTest
 
 
 !--------------------------------------------------------------------------------------------------
@@ -274,6 +283,7 @@ pure function math_identity2nd(dimen)
 
 end function math_identity2nd
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief symmetric fourth rank identity tensor of specified dimension
 !  from http://en.wikipedia.org/wiki/Tensor_derivative_(continuum_mechanics)#Derivative_of_a_second-order_tensor_with_respect_to_itself
@@ -626,6 +636,7 @@ pure function math_skew33(m)
 
 end function math_skew33
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief hydrostatic part of a 33 matrix
 !--------------------------------------------------------------------------------------------------

src/mesh_base.f90

@@ -9,12 +9,8 @@
 module mesh_base
 
   use, intrinsic :: iso_c_binding
-  use prec, only: &
+  use prec
-    pStringLen, &
+  use element
-    pReal, &
-    pInt
-  use element, only: &
-   tElement
   use future 
 
   implicit none
@@ -54,7 +50,6 @@ module mesh_base
 contains
 subroutine tMesh_base_init(self,meshType,elemType,nodes)
  
- implicit none
  class(tMesh) :: self
  character(len=*), intent(in) :: meshType
  integer(pInt), intent(in) :: elemType
@@ -74,8 +69,7 @@ end subroutine tMesh_base_init
 
 
 subroutine tMesh_base_setNelems(self,Nelems)
- 
+  
-  implicit none
   class(tMesh) :: self
   integer(pInt), intent(in) :: Nelems
 

src/numerics.f90

@@ -4,21 +4,14 @@
 !> @brief Managing of parameters related to numerics
 !--------------------------------------------------------------------------------------------------
 module numerics
- use prec, only: &
+ use prec
-   pInt, &
-   pReal
 
  implicit none
  private
 
  integer(pInt), protected, public :: &
    iJacoStiffness             =  1_pInt, &                                                          !< frequency of stiffness update
-   iJacoLpresiduum            =  1_pInt, &                                                          !< frequency of Jacobian update of residuum in Lp
    nMPstate                   = 10_pInt, &                                                          !< materialpoint state loop limit
-   nCryst                     = 20_pInt, &                                                          !< crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst")
-   nState                     = 10_pInt, &                                                          !< state loop limit
-   nStress                    = 40_pInt, &                                                          !< stress loop limit
-   pert_method                =  1_pInt, &                                                          !< method used in perturbation technique for tangent
    randomSeed                 =  0_pInt, &                                                          !< fixed seeding for pseudo-random number generator, Default 0: use random seed
    worldrank                  =  0_pInt, &                                                          !< MPI worldrank (/=0 for MPI simulations only)
    worldsize                  =  1_pInt, &                                                          !< MPI worldsize (/=1 for MPI simulations only)
@@ -26,20 +19,10 @@ module numerics
  integer(4), protected, public :: &
    DAMASK_NumThreadsInt       =  0                                                                  !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive
  real(pReal), protected, public :: &
-   relevantStrain             =  1.0e-7_pReal, &                                                    !< strain increment considered significant (used by crystallite to determine whether strain inc is considered significant)
    defgradTolerance           =  1.0e-7_pReal, &                                                    !< deviation of deformation gradient that is still allowed (used by CPFEM to determine outdated ffn1)
-   pert_Fg                    =  1.0e-7_pReal, &                                                    !< strain perturbation for FEM Jacobi
-   subStepMinCryst            =  1.0e-3_pReal, &                                                    !< minimum (relative) size of sub-step allowed during cutback in crystallite
    subStepMinHomog            =  1.0e-3_pReal, &                                                    !< minimum (relative) size of sub-step allowed during cutback in homogenization
-   subStepSizeCryst           =  0.25_pReal, &                                                      !< size of first substep when cutback in crystallite
    subStepSizeHomog           =  0.25_pReal, &                                                      !< size of first substep when cutback in homogenization
-   subStepSizeLp              =  0.5_pReal, &                                                       !< size of first substep when cutback in Lp calculation
-   subStepSizeLi              =  0.5_pReal, &                                                       !< size of first substep when cutback in Li calculation
-   stepIncreaseCryst          =  1.5_pReal, &                                                       !< increase of next substep size when previous substep converged in crystallite
    stepIncreaseHomog          =  1.5_pReal, &                                                       !< increase of next substep size when previous substep converged in homogenization
-   rTol_crystalliteState      =  1.0e-6_pReal, &                                                    !< relative tolerance in crystallite state loop 
-   rTol_crystalliteStress     =  1.0e-6_pReal, &                                                    !< relative tolerance in crystallite stress loop
-   aTol_crystalliteStress     =  1.0e-8_pReal, &                                                    !< absolute tolerance in crystallite stress loop, Default 1.0e-8: residuum is in Lp and hence strain is on this order
    numerics_unitlength        =  1.0_pReal, &                                                       !< determines the physical length of one computational length unit
    absTol_RGC                 =  1.0e+4_pReal, &                                                    !< absolute tolerance of RGC residuum
    relTol_RGC                 =  1.0e-3_pReal, &                                                    !< relative tolerance of RGC residuum
@@ -57,8 +40,7 @@ module numerics
    charLength                 =  1.0_pReal, &                                                       !< characteristic length scale for gradient problems
    residualStiffness          =  1.0e-6_pReal                                                       !< non-zero residual damage   
  logical, protected, public :: &                                                   
-   usePingPong                = .true., & 
+   usePingPong                = .true.
-   numerics_timeSyncing       = .false.                                                             !< flag indicating if time synchronization in crystallite is used for nonlocal plasticity
 
 !--------------------------------------------------------------------------------------------------
 ! field parameters:
@@ -131,8 +113,6 @@ contains
 ! a sanity check
 !--------------------------------------------------------------------------------------------------
 subroutine numerics_init
- use prec, only: &
-   pStringLen
  use IO, only: &
    IO_read_ASCII, &
    IO_error, &
@@ -148,7 +128,6 @@ subroutine numerics_init
    use petscsys
 #endif
 !$ use OMP_LIB, only: omp_set_num_threads
- implicit none
 !$ integer ::                                gotDAMASK_NUM_THREADS = 1
  integer :: i,j, ierr                                                                                 ! no pInt
  integer(pInt), allocatable, dimension(:) :: chunkPos
@@ -194,48 +173,18 @@ subroutine numerics_init
      tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt))                                              ! extract key
 
      select case(tag)
-       case ('relevantstrain')
-         relevantStrain = IO_floatValue(line,chunkPos,2_pInt)
        case ('defgradtolerance')
          defgradTolerance = IO_floatValue(line,chunkPos,2_pInt)
        case ('ijacostiffness')
          iJacoStiffness = IO_intValue(line,chunkPos,2_pInt)
-       case ('ijacolpresiduum')
-         iJacoLpresiduum = IO_intValue(line,chunkPos,2_pInt)
-       case ('pert_fg')
-         pert_Fg = IO_floatValue(line,chunkPos,2_pInt)
-       case ('pert_method')
-         pert_method = IO_intValue(line,chunkPos,2_pInt)
        case ('nmpstate')
          nMPstate = IO_intValue(line,chunkPos,2_pInt)
-       case ('ncryst')
-         nCryst = IO_intValue(line,chunkPos,2_pInt)
-       case ('nstate')
-         nState = IO_intValue(line,chunkPos,2_pInt)
-       case ('nstress')
-         nStress = IO_intValue(line,chunkPos,2_pInt)
-       case ('substepmincryst')
-         subStepMinCryst = IO_floatValue(line,chunkPos,2_pInt)
-       case ('substepsizecryst')
-         subStepSizeCryst = IO_floatValue(line,chunkPos,2_pInt)
-       case ('stepincreasecryst')
-         stepIncreaseCryst = IO_floatValue(line,chunkPos,2_pInt)
-       case ('substepsizelp')
-         subStepSizeLp = IO_floatValue(line,chunkPos,2_pInt)
-       case ('substepsizeli')
-         subStepSizeLi = IO_floatValue(line,chunkPos,2_pInt)
        case ('substepminhomog')
          subStepMinHomog = IO_floatValue(line,chunkPos,2_pInt)
        case ('substepsizehomog')
          subStepSizeHomog = IO_floatValue(line,chunkPos,2_pInt)
        case ('stepincreasehomog')
          stepIncreaseHomog = IO_floatValue(line,chunkPos,2_pInt)
-       case ('rtol_crystallitestate')
-         rTol_crystalliteState = IO_floatValue(line,chunkPos,2_pInt)
-       case ('rtol_crystallitestress')
-         rTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt)
-       case ('atol_crystallitestress')
-         aTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt)
        case ('integrator')
          numerics_integrator = IO_intValue(line,chunkPos,2_pInt)
        case ('usepingpong')
@@ -356,23 +305,8 @@ subroutine numerics_init
 
 !--------------------------------------------------------------------------------------------------
 ! writing parameters to output
- write(6,'(a24,1x,es8.1)')  ' relevantStrain:         ',relevantStrain
  write(6,'(a24,1x,es8.1)')  ' defgradTolerance:       ',defgradTolerance
  write(6,'(a24,1x,i8)')     ' iJacoStiffness:         ',iJacoStiffness
- write(6,'(a24,1x,i8)')     ' iJacoLpresiduum:        ',iJacoLpresiduum
- write(6,'(a24,1x,es8.1)')  ' pert_Fg:                ',pert_Fg
- write(6,'(a24,1x,i8)')     ' pert_method:            ',pert_method
- write(6,'(a24,1x,i8)')     ' nCryst:                 ',nCryst
- write(6,'(a24,1x,es8.1)')  ' subStepMinCryst:        ',subStepMinCryst
- write(6,'(a24,1x,es8.1)')  ' subStepSizeCryst:       ',subStepSizeCryst
- write(6,'(a24,1x,es8.1)')  ' stepIncreaseCryst:      ',stepIncreaseCryst
- write(6,'(a24,1x,es8.1)')  ' subStepSizeLp:          ',subStepSizeLp
- write(6,'(a24,1x,es8.1)')  ' subStepSizeLi:          ',subStepSizeLi
- write(6,'(a24,1x,i8)')     ' nState:                 ',nState
- write(6,'(a24,1x,i8)')     ' nStress:                ',nStress
- write(6,'(a24,1x,es8.1)')  ' rTol_crystalliteState:  ',rTol_crystalliteState
- write(6,'(a24,1x,es8.1)')  ' rTol_crystalliteStress: ',rTol_crystalliteStress
- write(6,'(a24,1x,es8.1)')  ' aTol_crystalliteStress: ',aTol_crystalliteStress
  write(6,'(a24,1x,i8)')     ' integrator:             ',numerics_integrator
  write(6,'(a24,1x,L8)')     ' use ping pong scheme:   ',usepingpong
  write(6,'(a24,1x,es8.1,/)')' unitlength:             ',numerics_unitlength
@@ -452,28 +386,12 @@ subroutine numerics_init
 
 !--------------------------------------------------------------------------------------------------
 ! sanity checks
- if (relevantStrain <= 0.0_pReal)          call IO_error(301_pInt,ext_msg='relevantStrain')
  if (defgradTolerance <= 0.0_pReal)        call IO_error(301_pInt,ext_msg='defgradTolerance')
  if (iJacoStiffness < 1_pInt)              call IO_error(301_pInt,ext_msg='iJacoStiffness')
- if (iJacoLpresiduum < 1_pInt)             call IO_error(301_pInt,ext_msg='iJacoLpresiduum')
- if (pert_Fg <= 0.0_pReal)                 call IO_error(301_pInt,ext_msg='pert_Fg')
- if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) &
-                                           call IO_error(301_pInt,ext_msg='pert_method')
  if (nMPstate < 1_pInt)                    call IO_error(301_pInt,ext_msg='nMPstate')
- if (nCryst < 1_pInt)                      call IO_error(301_pInt,ext_msg='nCryst')
- if (nState < 1_pInt)                      call IO_error(301_pInt,ext_msg='nState')
- if (nStress < 1_pInt)                     call IO_error(301_pInt,ext_msg='nStress')
- if (subStepMinCryst <= 0.0_pReal)         call IO_error(301_pInt,ext_msg='subStepMinCryst')
- if (subStepSizeCryst <= 0.0_pReal)        call IO_error(301_pInt,ext_msg='subStepSizeCryst')
- if (stepIncreaseCryst <= 0.0_pReal)       call IO_error(301_pInt,ext_msg='stepIncreaseCryst')
- if (subStepSizeLp <= 0.0_pReal)           call IO_error(301_pInt,ext_msg='subStepSizeLp')
- if (subStepSizeLi <= 0.0_pReal)           call IO_error(301_pInt,ext_msg='subStepSizeLi')
  if (subStepMinHomog <= 0.0_pReal)         call IO_error(301_pInt,ext_msg='subStepMinHomog')
  if (subStepSizeHomog <= 0.0_pReal)        call IO_error(301_pInt,ext_msg='subStepSizeHomog')
  if (stepIncreaseHomog <= 0.0_pReal)       call IO_error(301_pInt,ext_msg='stepIncreaseHomog')
- if (rTol_crystalliteState <= 0.0_pReal)   call IO_error(301_pInt,ext_msg='rTol_crystalliteState')
- if (rTol_crystalliteStress <= 0.0_pReal)  call IO_error(301_pInt,ext_msg='rTol_crystalliteStress')
- if (aTol_crystalliteStress <= 0.0_pReal)  call IO_error(301_pInt,ext_msg='aTol_crystalliteStress')
  if (numerics_integrator <= 0_pInt .or. numerics_integrator >= 6_pInt) &
                                            call IO_error(301_pInt,ext_msg='integrator')
  if (numerics_unitlength <= 0.0_pReal)     call IO_error(301_pInt,ext_msg='unitlength')

src/plastic_dislotwin.f90

@@ -8,17 +8,26 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module plastic_dislotwin
- use prec, only: &
+  use prec
-   pReal
+  use debug
+  use math
+  use IO
+  use material
+  use config
+  use lattice
+#if defined(PETSc) || defined(DAMASK_HDF5)
+  use results
+#endif
 
  implicit none
  private
+ 
  integer,                       dimension(:,:),  allocatable, target, public :: &
    plastic_dislotwin_sizePostResult                                                                 !< size of each post result output
  character(len=64),             dimension(:,:),  allocatable, target, public :: &
    plastic_dislotwin_output                                                                         !< name of each post result output
 
- real(pReal),                                    parameter,           private :: &
+ real(pReal),                                    parameter :: &
    kB = 1.38e-23_pReal                                                                              !< Boltzmann constant in J/Kelvin
 
  enum, bind(c)
@@ -39,7 +48,7 @@ module plastic_dislotwin
      f_tr_ID
  end enum
 
- type, private :: tParameters
+ type :: tParameters
    real(pReal) :: &
      mu, &
      nu, &
@@ -119,7 +128,7 @@ module plastic_dislotwin
      dipoleFormation                                                                                !< flag indicating consideration of dipole formation
  end type                                                                                           !< container type for internal constitutive parameters
 
- type, private :: tDislotwinState
+ type :: tDislotwinState
    real(pReal),                  dimension(:,:),   pointer :: &
      rho_mob, &
      rho_dip, &
@@ -128,7 +137,7 @@ module plastic_dislotwin
      f_tr
  end type tDislotwinState
 
- type, private :: tDislotwinMicrostructure
+ type :: tDislotwinMicrostructure
    real(pReal),                  dimension(:,:),   allocatable :: &
      Lambda_sl, & !* mean free path between 2 obstacles seen by a moving dislocation
      Lambda_tw, &  !* mean free path between 2 obstacles seen by a growing twin
@@ -144,11 +153,11 @@ module plastic_dislotwin
 
 !--------------------------------------------------------------------------------------------------
 ! containers for parameters and state
- type(tParameters),              allocatable, dimension(:), private :: param
+ type(tParameters),              allocatable, dimension(:) :: param
- type(tDislotwinState),          allocatable, dimension(:), private :: &
+ type(tDislotwinState),          allocatable, dimension(:) :: &
    dotState, &
    state
- type(tDislotwinMicrostructure), allocatable, dimension(:), private :: dependentState
+ type(tDislotwinMicrostructure), allocatable, dimension(:) :: dependentState
 
  public :: &
    plastic_dislotwin_init, &
@@ -158,10 +167,6 @@ module plastic_dislotwin
    plastic_dislotwin_dotState, &
    plastic_dislotwin_postResults, &
    plastic_dislotwin_results
- private :: &
-   kinetics_slip, &
-   kinetics_twin, &
-   kinetics_trans
 
 contains
 
@@ -171,24 +176,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_dislotwin_init
- use prec, only: &
-   pStringLen, &
-   dEq0, &
-   dNeq0, &
-   dNeq
- use debug, only: &
-   debug_level,&
-   debug_constitutive,&
-   debug_levelBasic
- use math, only: &
-   math_expand,&
-   PI
- use IO, only: &
-   IO_error
- use material
- use config, only: &
-   config_phase
- use lattice
 
  integer :: &
    Ninstance, &
@@ -591,10 +578,6 @@ end subroutine plastic_dislotwin_init
 !> @brief returns the homogenized elasticity matrix
 !--------------------------------------------------------------------------------------------------
 function plastic_dislotwin_homogenizedC(ipc,ip,el) result(homogenizedC)
- use material, only: &
-  material_phase, &
-  phase_plasticityInstance, &
-  phasememberAt
  
  real(pReal), dimension(6,6) :: &
    homogenizedC
@@ -634,14 +617,6 @@ end function plastic_dislotwin_homogenizedC
 !> @brief calculates plastic velocity gradient and its tangent
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_dislotwin_LpAndItsTangent(Lp,dLp_dMp,Mp,T,instance,of)
- use prec, only: &
-   tol_math_check, &
-   dNeq0
- use math, only: &
-   math_eigenValuesVectorsSym, &
-   math_outer, &
-   math_symmetric33, &
-   math_mul33xx33
  
  real(pReal), dimension(3,3),     intent(out) :: Lp
  real(pReal), dimension(3,3,3,3), intent(out) :: dLp_dMp
@@ -757,13 +732,6 @@ end subroutine plastic_dislotwin_LpAndItsTangent
 !> @brief calculates the rate of change of microstructure
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_dislotwin_dotState(Mp,T,instance,of)
- use prec, only: &
-   tol_math_check, &
-   dEq0
- use math, only: &
-   math_clip, &
-   math_mul33xx33, &
-   PI 
 
  real(pReal), dimension(3,3),  intent(in):: &
    Mp                                                                                               !< Mandel stress
@@ -854,8 +822,6 @@ end subroutine plastic_dislotwin_dotState
 !> @brief calculates derived quantities from state
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_dislotwin_dependentState(T,instance,of)
- use math, only: &
-   PI
 
  integer,       intent(in) :: &
    instance, &
@@ -868,13 +834,13 @@ subroutine plastic_dislotwin_dependentState(T,instance,of)
  real(pReal) :: &
    sumf_twin,SFE,sumf_trans
  real(pReal), dimension(param(instance)%sum_N_sl) :: &
-   inv_lambda_sl_sl, & !* 1/mean free distance between 2 forest dislocations seen by a moving dislocation
+   inv_lambda_sl_sl, & !< 1/mean free distance between 2 forest dislocations seen by a moving dislocation
-   inv_lambda_sl_tw, & !* 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation
+   inv_lambda_sl_tw, & !< 1/mean free distance between 2 twin stacks from different systems seen by a moving dislocation
-   inv_lambda_sl_tr    !* 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation
+   inv_lambda_sl_tr    !< 1/mean free distance between 2 martensite lamellar from different systems seen by a moving dislocation
  real(pReal), dimension(param(instance)%sum_N_tw) :: &
-   inv_lambda_tw_tw  !* 1/mean free distance between 2 twin stacks from different systems seen by a growing twin
+   inv_lambda_tw_tw    !< 1/mean free distance between 2 twin stacks from different systems seen by a growing twin
   real(pReal), dimension(param(instance)%sum_N_tr) :: &
-   inv_lambda_tr_tr  !* 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite (1/lambda_trans)
+   inv_lambda_tr_tr    !< 1/mean free distance between 2 martensite stacks from different systems seen by a growing martensite
 
  real(pReal), dimension(:), allocatable :: &
    x0, &
@@ -967,12 +933,6 @@ end subroutine plastic_dislotwin_dependentState
 !> @brief return array of constitutive results
 !--------------------------------------------------------------------------------------------------
 function plastic_dislotwin_postResults(Mp,T,instance,of) result(postResults)
- use prec, only: &
-   tol_math_check, &
-   dEq0
- use math, only: &
-   PI, &
-   math_mul33xx33
 
  real(pReal), dimension(3,3),intent(in) :: &
    Mp                                                                                               !< 2nd Piola Kirchhoff stress tensor in Mandel notation
@@ -1050,8 +1010,6 @@ end function plastic_dislotwin_postResults
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_dislotwin_results(instance,group)
 #if defined(PETSc) || defined(DAMASK_HDF5)
-  use results, only: &
-    results_writeDataset
 
   integer, intent(in) :: instance
   character(len=*) :: group
@@ -1067,8 +1025,8 @@ subroutine plastic_dislotwin_results(instance,group)
       case (rho_dip_ID)
         call results_writeDataset(group,stt%rho_dip,'rho_dip',&
                                   'dislocation dipole density''1/m²')
-      case (dot_gamma_sl_ID)
+      case (gamma_sl_ID)
-        call results_writeDataset(group,stt%gamma_sl,'dot_gamma_sl',&
+        call results_writeDataset(group,stt%gamma_sl,'gamma_sl',&
                                   'plastic shear','1')
       case (Lambda_sl_ID)
         call results_writeDataset(group,dst%Lambda_sl,'Lambda_sl',&
@@ -1112,11 +1070,6 @@ end subroutine plastic_dislotwin_results
 !--------------------------------------------------------------------------------------------------
 pure subroutine kinetics_slip(Mp,T,instance,of, &
                               dot_gamma_sl,ddot_gamma_dtau_slip,tau_slip)
- use prec, only: &
-  tol_math_check, &
-  dNeq0
- use math, only: &
-   math_mul33xx33
 
  real(pReal), dimension(3,3),  intent(in) :: &
    Mp                                                                                               !< Mandel stress
@@ -1190,11 +1143,6 @@ end subroutine kinetics_slip
 !--------------------------------------------------------------------------------------------------
 pure subroutine kinetics_twin(Mp,T,dot_gamma_sl,instance,of,&
                               dot_gamma_twin,ddot_gamma_dtau_twin)
- use prec, only: &
-   tol_math_check, &
-   dNeq0
- use math, only: &
-   math_mul33xx33
 
  real(pReal), dimension(3,3),  intent(in) :: &
    Mp                                                                                               !< Mandel stress
@@ -1261,11 +1209,6 @@ end subroutine kinetics_twin
 !--------------------------------------------------------------------------------------------------
 pure subroutine kinetics_trans(Mp,T,dot_gamma_sl,instance,of,&
                               dot_gamma_tr,ddot_gamma_dtau_trans)
- use prec, only: &
-   tol_math_check, &
-   dNeq0
- use math, only: &
-   math_mul33xx33
 
  real(pReal), dimension(3,3),  intent(in) :: &
    Mp                                                                                               !< Mandel stress

src/plastic_isotropic.f90

@@ -8,11 +8,19 @@
 !! untextured polycrystal
 !--------------------------------------------------------------------------------------------------
 module plastic_isotropic
-  use prec, only: &
+  use prec
-    pReal
+  use debug
+  use math
+  use IO
+  use material
+  use config
+#if defined(PETSc) || defined(DAMASK_HDF5)
+  use results
+#endif
  
   implicit none
   private
+  
   integer,           dimension(:,:),   allocatable, target, public :: &
     plastic_isotropic_sizePostResult                                                                !< size of each post result output
   character(len=64), dimension(:,:),   allocatable, target, public :: &
@@ -25,7 +33,7 @@ module plastic_isotropic
       dot_gamma_ID
   end enum
  
-  type, private :: tParameters
+  type :: tParameters
     real(pReal) :: &
       M, &                                                                                          !< Taylor factor
       xi_0, &                                                                                       !< initial critical stress
@@ -49,7 +57,7 @@ module plastic_isotropic
       dilatation
   end type tParameters
  
-  type, private :: tIsotropicState
+  type :: tIsotropicState
     real(pReal), pointer, dimension(:) :: &
       xi, &
       gamma
@@ -57,8 +65,8 @@ module plastic_isotropic
 
 !--------------------------------------------------------------------------------------------------
 ! containers for parameters and state
- type(tParameters),     allocatable, dimension(:), private :: param
+ type(tParameters),     allocatable, dimension(:) :: param
- type(tIsotropicState), allocatable, dimension(:), private :: &
+ type(tIsotropicState), allocatable, dimension(:) :: &
    dotState, &
    state
 
@@ -77,25 +85,7 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_isotropic_init
-  use prec, only: &
+
-    pStringLen
-  use debug, only: &
-#ifdef DEBUG
-    debug_e, &
-    debug_i, &
-    debug_g, &
-    debug_levelExtensive, &
-#endif
-    debug_level, &
-    debug_constitutive, &
-    debug_levelBasic
-  use IO, only: &
-    IO_error
-  use material
-  use config, only: &
-    config_phase
-  use lattice
- 
   integer :: &
     Ninstance, &
     p, i, &
@@ -235,16 +225,6 @@ end subroutine plastic_isotropic_init
 !> @brief calculates plastic velocity gradient and its tangent
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_isotropic_LpAndItsTangent(Lp,dLp_dMp,Mp,instance,of)
-#ifdef DEBUG
-  use debug, only: &
-    debug_level, &
-    debug_constitutive,&
-    debug_levelExtensive, &
-    debug_levelSelective
-#endif
-  use math, only: &
-    math_deviatoric33, &
-    math_mul33xx33
  
   real(pReal), dimension(3,3),     intent(out) :: &
     Lp                                                                                              !< plastic velocity gradient
@@ -307,10 +287,6 @@ end subroutine plastic_isotropic_LpAndItsTangent
 ! ToDo: Rename Tstar to Mi?
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of)
-  use math, only: &
-    math_I3, &
-    math_spherical33, &
-    math_mul33xx33
  
   real(pReal), dimension(3,3), intent(out) :: &
     Li                                                                                              !< inleastic velocity gradient
@@ -362,11 +338,6 @@ subroutine plastic_isotropic_LiAndItsTangent(Li,dLi_dTstar,Tstar,instance,of)
 !> @brief calculates the rate of change of microstructure
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_isotropic_dotState(Mp,instance,of)
-  use prec, only: &
-    dEq0
-  use math, only: &
-    math_mul33xx33, &
-    math_deviatoric33
  
   real(pReal), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
@@ -416,9 +387,6 @@ end subroutine plastic_isotropic_dotState
 !> @brief return array of constitutive results
 !--------------------------------------------------------------------------------------------------
 function plastic_isotropic_postResults(Mp,instance,of) result(postResults)
-  use math, only: &
-    math_mul33xx33, &
-    math_deviatoric33
  
   real(pReal), dimension(3,3),  intent(in) :: &
     Mp                                                                                              !< Mandel stress
@@ -468,7 +436,6 @@ end function plastic_isotropic_postResults
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_isotropic_results(instance,group)
 #if defined(PETSc) || defined(DAMASKHDF5)
-  use results
 
   integer, intent(in) :: instance
   character(len=*), intent(in) :: group

src/plastic_kinematichardening.f90

@@ -6,11 +6,20 @@
 !! and a Voce-type kinematic hardening rule
 !--------------------------------------------------------------------------------------------------
 module plastic_kinehardening
- use prec, only: &
+ use prec
-   pReal
+ use debug
+ use math
+ use IO
+ use material
+ use config
+ use lattice
+#if defined(PETSc) || defined(DAMASK_HDF5)
+ use results
+#endif
 
  implicit none
  private
+
  integer,           dimension(:,:),   allocatable, target, public :: &
    plastic_kinehardening_sizePostResult                                                             !< size of each post result output
  character(len=64), dimension(:,:),   allocatable, target, public :: &
@@ -29,7 +38,7 @@ module plastic_kinehardening
      resolvedstress_ID
  end enum
 
- type, private :: tParameters
+ type :: tParameters
    real(pReal) :: &
      gdot0, &                                                                                       !< reference shear strain rate for slip
      n, &                                                                                           !< stress exponent for slip
@@ -59,7 +68,7 @@ module plastic_kinehardening
      outputID                                                                                       !< ID of each post result output
  end type tParameters
 
- type, private :: tKinehardeningState
+ type :: tKinehardeningState
    real(pReal), pointer, dimension(:,:) :: &                                                        !< vectors along NipcMyInstance
      crss, &                                                                                        !< critical resolved stress
      crss_back, &                                                                                   !< critical resolved back stress
@@ -71,8 +80,8 @@ module plastic_kinehardening
 
 !--------------------------------------------------------------------------------------------------
 ! containers for parameters and state
- type(tParameters),         allocatable, dimension(:), private :: param
+ type(tParameters),         allocatable, dimension(:) :: param
- type(tKinehardeningState), allocatable, dimension(:), private :: &
+ type(tKinehardeningState), allocatable, dimension(:) :: &
    dotState, &
    deltaState, &
    state
@@ -84,8 +93,6 @@ module plastic_kinehardening
    plastic_kinehardening_deltaState, &
    plastic_kinehardening_postResults, &
    plastic_kinehardening_results
- private :: &
-   kinetics
 
 contains
 
@@ -95,27 +102,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_kinehardening_init
- use prec, only: &
-   dEq0, &
-   pStringLen
- use debug, only: &
-#ifdef DEBUG
-   debug_e, &
-   debug_i, &
-   debug_g, &
-   debug_levelExtensive, &
-#endif
-   debug_level, &
-   debug_constitutive,&
-   debug_levelBasic
- use math, only: &
-   math_expand
- use IO, only: &
-   IO_error
- use material
- use config, only: &
-   config_phase
- use lattice
 
  integer :: &
    Ninstance, &
@@ -417,16 +403,6 @@ end subroutine plastic_kinehardening_dotState
 !> @brief calculates (instantaneous) incremental change of microstructure
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_kinehardening_deltaState(Mp,instance,of)
- use prec, only: &
-   dNeq, &
-   dEq0
-#ifdef DEBUG
- use debug, only: &
-   debug_level, &
-   debug_constitutive,&
-   debug_levelExtensive, &
-   debug_levelSelective
-#endif
 
  real(pReal), dimension(3,3),  intent(in) :: &
    Mp                                                                                               !< Mandel stress
@@ -475,8 +451,6 @@ end subroutine plastic_kinehardening_deltaState
 !> @brief return array of constitutive results
 !--------------------------------------------------------------------------------------------------
 function plastic_kinehardening_postResults(Mp,instance,of) result(postResults)
- use math, only: &
-   math_mul33xx33
 
  real(pReal), dimension(3,3), intent(in) :: &
    Mp                                                                                               !< Mandel stress
@@ -535,8 +509,6 @@ end function plastic_kinehardening_postResults
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_kinehardening_results(instance,group)
 #if defined(PETSc) || defined(DAMASK_HDF5)
-  use results, only: &
-    results_writeDataset
 
   integer, intent(in) :: instance
   character(len=*) :: group
@@ -585,10 +557,6 @@ end subroutine plastic_kinehardening_results
 !--------------------------------------------------------------------------------------------------
 pure subroutine kinetics(Mp,instance,of, &
                          gdot_pos,gdot_neg,dgdot_dtau_pos,dgdot_dtau_neg)
- use prec, only: &
-   dNeq0
- use math, only: &
-   math_mul33xx33
 
  real(pReal), dimension(3,3),  intent(in) :: &
    Mp                                                                                               !< Mandel stress

src/plastic_none.f90

@@ -5,6 +5,8 @@
 !> @brief Dummy plasticity for purely elastic material
 !--------------------------------------------------------------------------------------------------
 module plastic_none
+ use material
+ use debug
 
  implicit none
  private
@@ -19,11 +21,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_none_init
- use debug, only: &
-   debug_level, &
-   debug_constitutive, &
-   debug_levelBasic
- use material
 
  integer :: &
    Ninstance, &

src/plastic_phenopowerlaw.f90

@@ -5,11 +5,20 @@
 !> @brief  phenomenological crystal plasticity formulation using a powerlaw fitting
 !--------------------------------------------------------------------------------------------------
 module plastic_phenopowerlaw
- use prec, only: &
+ use prec
-   pReal
+ use debug
+ use math
+ use IO
+ use material
+ use config
+ use lattice
+#if defined(PETSc) || defined(DAMASK_HDF5)
+ use results
+#endif
 
  implicit none
  private
+ 
  integer,          dimension(:,:),   allocatable, target, public :: &
    plastic_phenopowerlaw_sizePostResult                                                             !< size of each post result output
  character(len=64), dimension(:,:),   allocatable, target, public :: &
@@ -28,7 +37,7 @@ module plastic_phenopowerlaw
      resolvedstress_twin_ID
  end enum
 
- type, private :: tParameters
+ type :: tParameters
    real(pReal) :: &
      gdot0_slip, &                                                                                  !< reference shear strain rate for slip
      gdot0_twin, &                                                                                  !< reference shear strain rate for twin
@@ -73,7 +82,7 @@ module plastic_phenopowerlaw
      outputID                                                                                       !< ID of each post result output
  end type tParameters
 
- type, private :: tPhenopowerlawState
+ type :: tPhenopowerlawState
    real(pReal), pointer, dimension(:,:) :: &
      xi_slip, &
      xi_twin, &
@@ -83,8 +92,8 @@ module plastic_phenopowerlaw
 
 !--------------------------------------------------------------------------------------------------
 ! containers for parameters and state
- type(tParameters),         allocatable, dimension(:), private :: param
+ type(tParameters),         allocatable, dimension(:) :: param
- type(tPhenopowerlawState), allocatable, dimension(:), private :: &
+ type(tPhenopowerlawState), allocatable, dimension(:) :: &
    dotState, &
    state
 
@@ -94,9 +103,6 @@ module plastic_phenopowerlaw
    plastic_phenopowerlaw_dotState, &
    plastic_phenopowerlaw_postResults, &
    plastic_phenopowerlaw_results
- private :: &
-   kinetics_slip, &
-   kinetics_twin
 
 contains
 
@@ -106,20 +112,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_phenopowerlaw_init
- use prec, only: &
-   pStringLen
- use debug, only: &
-   debug_level, &
-   debug_constitutive,&
-   debug_levelBasic
- use math, only: &
-   math_expand
- use IO, only: &
-   IO_error
- use material
- use config, only: &
-   config_phase
- use lattice
 
  integer :: &
    Ninstance, &
@@ -484,8 +476,6 @@ end subroutine plastic_phenopowerlaw_dotState
 !> @brief return array of constitutive results
 !--------------------------------------------------------------------------------------------------
 function plastic_phenopowerlaw_postResults(Mp,instance,of) result(postResults)
- use math, only: &
-   math_mul33xx33
 
  real(pReal), dimension(3,3), intent(in) :: &
    Mp                                                                                               !< Mandel stress
@@ -552,8 +542,6 @@ end function plastic_phenopowerlaw_postResults
 !--------------------------------------------------------------------------------------------------
 subroutine plastic_phenopowerlaw_results(instance,group)
 #if defined(PETSc) || defined(DAMASK_HDF5)
-  use results, only: &
-    results_writeDataset
 
   integer,          intent(in) :: instance
   character(len=*), intent(in) :: group
@@ -598,10 +586,6 @@ end subroutine plastic_phenopowerlaw_results
 !--------------------------------------------------------------------------------------------------
 pure subroutine kinetics_slip(Mp,instance,of, &
                               gdot_slip_pos,gdot_slip_neg,dgdot_dtau_slip_pos,dgdot_dtau_slip_neg)
- use prec, only: &
-   dNeq0
- use math, only: &
-   math_mul33xx33
 
  real(pReal), dimension(3,3),  intent(in) :: &
    Mp                                                                                               !< Mandel stress
@@ -674,10 +658,6 @@ end subroutine kinetics_slip
 !--------------------------------------------------------------------------------------------------
 pure subroutine kinetics_twin(Mp,instance,of,&
                               gdot_twin,dgdot_dtau_twin)
- use prec, only: &
-  dNeq0
- use math, only: &
-   math_mul33xx33
 
  real(pReal), dimension(3,3),  intent(in) :: &
    Mp                                                                                               !< Mandel stress

src/quaternions.f90

@@ -3,27 +3,27 @@
 ! Modified      2017-2019, Martin Diehl/Max-Planck-Institut für Eisenforschung GmbH
 ! All rights reserved.
 !
-! Redistribution and use in source and binary forms, with or without modification, are 
+! Redistribution and use in source and binary forms, with or without modification, are
 ! permitted provided that the following conditions are met:
 !
-!     - Redistributions of source code must retain the above copyright notice, this list 
+!     - Redistributions of source code must retain the above copyright notice, this list
 !        of conditions and the following disclaimer.
-!     - Redistributions in binary form must reproduce the above copyright notice, this 
+!     - Redistributions in binary form must reproduce the above copyright notice, this
-!        list of conditions and the following disclaimer in the documentation and/or 
+!        list of conditions and the following disclaimer in the documentation and/or
 !        other materials provided with the distribution.
-!     - Neither the names of Marc De Graef, Carnegie Mellon University nor the names 
+!     - Neither the names of Marc De Graef, Carnegie Mellon University nor the names
-!        of its contributors may be used to endorse or promote products derived from 
+!        of its contributors may be used to endorse or promote products derived from
 !        this software without specific prior written permission.
 !
-! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 
+! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 
+! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE 
+! ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
-! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
+! LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 
+! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 
+! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 
+! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE 
+! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
 ! USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ! ###################################################################
 
@@ -34,58 +34,57 @@
 !> @details  w is the real part, (x, y, z) are the imaginary parts.
 !---------------------------------------------------------------------------------------------------
 module quaternions
- use prec, only: &
+  use prec
-   pReal
+  use future
- use future
 
- implicit none
+  implicit none
- public
+  public
- 
- real(pReal), parameter, public :: P = -1.0_pReal                                                   !< parameter for orientation conversion.
- 
- type, public :: quaternion
-   real(pReal) :: w = 0.0_pReal
-   real(pReal) :: x = 0.0_pReal
-   real(pReal) :: y = 0.0_pReal
-   real(pReal) :: z = 0.0_pReal
- 
 
- contains
+  real(pReal), parameter, public :: P = -1.0_pReal                                                  !< parameter for orientation conversion.
-   procedure, private :: add__
-   procedure, private :: pos__
-   generic,   public  :: operator(+) => add__,pos__
 
-   procedure, private :: sub__
+  type, public :: quaternion
-   procedure, private :: neg__
+    real(pReal) :: w = 0.0_pReal
-   generic,   public  :: operator(-) => sub__,neg__
+    real(pReal) :: x = 0.0_pReal
+    real(pReal) :: y = 0.0_pReal
+    real(pReal) :: z = 0.0_pReal
 
-   procedure, private :: mul_quat__
-   procedure, private :: mul_scal__
-   generic,   public  :: operator(*) => mul_quat__, mul_scal__
 
-   procedure, private :: div_quat__
+  contains
-   procedure, private :: div_scal__
+    procedure, private :: add__
-   generic,   public  :: operator(/) => div_quat__, div_scal__
+    procedure, private :: pos__
+    generic,   public  :: operator(+) => add__,pos__
 
-   procedure, private :: eq__
+    procedure, private :: sub__
-   generic,   public  :: operator(==) => eq__
+    procedure, private :: neg__
+    generic,   public  :: operator(-) => sub__,neg__
 
-   procedure, private :: neq__
+    procedure, private :: mul_quat__
-   generic,   public  :: operator(/=) => neq__
+    procedure, private :: mul_scal__
+    generic,   public  :: operator(*) => mul_quat__, mul_scal__
 
-   procedure, private :: pow_quat__
+    procedure, private :: div_quat__
-   procedure, private :: pow_scal__
+    procedure, private :: div_scal__
-   generic,   public  :: operator(**) => pow_quat__, pow_scal__
+    generic,   public  :: operator(/) => div_quat__, div_scal__
 
-   procedure, public  :: abs__
+    procedure, private :: eq__
-   procedure, public  :: dot_product__
+    generic,   public  :: operator(==) => eq__
-   procedure, public  :: conjg__
-   procedure, public  :: exp__
-   procedure, public  :: log__
 
-   procedure, public  :: homomorphed => quat_homomorphed
+    procedure, private :: neq__
+    generic,   public  :: operator(/=) => neq__
 
- end type
+    procedure, private :: pow_quat__
+    procedure, private :: pow_scal__
+    generic,   public  :: operator(**) => pow_quat__, pow_scal__
+
+    procedure, public  :: abs__
+    procedure, public  :: dot_product__
+    procedure, public  :: conjg__
+    procedure, public  :: exp__
+    procedure, public  :: log__
+
+    procedure, public  :: homomorphed => quat_homomorphed
+
+  end type
 
 interface assignment (=)
   module procedure assign_quat__
@@ -124,12 +123,12 @@ contains
 !---------------------------------------------------------------------------------------------------
 type(quaternion) pure function init__(array)
 
- real(pReal), intent(in), dimension(4) :: array
+  real(pReal), intent(in), dimension(4) :: array
-    
+
- init__%w=array(1)
+  init__%w=array(1)
- init__%x=array(2)
+  init__%x=array(2)
- init__%y=array(3)
+  init__%y=array(3)
- init__%z=array(4)
+  init__%z=array(4)
 
 end function init__
 
@@ -139,14 +138,14 @@ end function init__
 !---------------------------------------------------------------------------------------------------
 elemental subroutine assign_quat__(self,other)
 
- type(quaternion), intent(out) :: self
+  type(quaternion), intent(out) :: self
- type(quaternion), intent(in)  :: other
+  type(quaternion), intent(in)  :: other
-    
+
- self%w = other%w
+  self%w = other%w
- self%x = other%x
+  self%x = other%x
- self%y = other%y
+  self%y = other%y
- self%z = other%z
+  self%z = other%z
-  
+
 end subroutine assign_quat__
 
 
@@ -155,14 +154,14 @@ end subroutine assign_quat__
 !---------------------------------------------------------------------------------------------------
 pure subroutine assign_vec__(self,other)
 
- type(quaternion), intent(out)                :: self
+  type(quaternion), intent(out)                :: self
- real(pReal),       intent(in), dimension(4)  :: other
+  real(pReal),       intent(in), dimension(4)  :: other
-    
+
- self%w = other(1)
+  self%w = other(1)
- self%x = other(2)
+  self%x = other(2)
- self%y = other(3)
+  self%y = other(3)
- self%z = other(4)
+  self%z = other(4)
-  
+
 end subroutine assign_vec__
 
 
@@ -171,13 +170,13 @@ end subroutine assign_vec__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function add__(self,other)
 
- class(quaternion), intent(in) :: self,other
+  class(quaternion), intent(in) :: self,other
-    
+
- add__%w = self%w + other%w
+  add__%w = self%w + other%w
- add__%x = self%x + other%x
+  add__%x = self%x + other%x
- add__%y = self%y + other%y
+  add__%y = self%y + other%y
- add__%z = self%z + other%z
+  add__%z = self%z + other%z
-  
+
 end function add__
 
 
@@ -186,13 +185,13 @@ end function add__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function pos__(self)
 
- class(quaternion), intent(in) :: self
+  class(quaternion), intent(in) :: self
-    
+
- pos__%w = self%w 
+  pos__%w = self%w
- pos__%x = self%x 
+  pos__%x = self%x
- pos__%y = self%y 
+  pos__%y = self%y
- pos__%z = self%z 
+  pos__%z = self%z
-  
+
 end function pos__
 
 
@@ -201,13 +200,13 @@ end function pos__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function sub__(self,other)
 
- class(quaternion), intent(in) :: self,other
+  class(quaternion), intent(in) :: self,other
-    
+
- sub__%w = self%w - other%w
+  sub__%w = self%w - other%w
- sub__%x = self%x - other%x
+  sub__%x = self%x - other%x
- sub__%y = self%y - other%y
+  sub__%y = self%y - other%y
- sub__%z = self%z - other%z
+  sub__%z = self%z - other%z
-  
+
 end function sub__
 
 
@@ -216,13 +215,13 @@ end function sub__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function neg__(self)
 
- class(quaternion), intent(in) :: self
+  class(quaternion), intent(in) :: self
-    
+
- neg__%w = -self%w 
+  neg__%w = -self%w
- neg__%x = -self%x 
+  neg__%x = -self%x
- neg__%y = -self%y 
+  neg__%y = -self%y
- neg__%z = -self%z 
+  neg__%z = -self%z
-  
+
 end function neg__
 
 
@@ -231,13 +230,13 @@ end function neg__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function mul_quat__(self,other)
 
- class(quaternion), intent(in) :: self, other
+  class(quaternion), intent(in) :: self, other
+
+  mul_quat__%w = self%w*other%w - self%x*other%x -      self%y*other%y - self%z*other%z
+  mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y)
+  mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z)
+  mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x)
 
- mul_quat__%w = self%w*other%w - self%x*other%x -      self%y*other%y - self%z*other%z
- mul_quat__%x = self%w*other%x + self%x*other%w + P * (self%y*other%z - self%z*other%y)
- mul_quat__%y = self%w*other%y + self%y*other%w + P * (self%z*other%x - self%x*other%z)
- mul_quat__%z = self%w*other%z + self%z*other%w + P * (self%x*other%y - self%y*other%x)
-    
 end function mul_quat__
 
 
@@ -246,14 +245,14 @@ end function mul_quat__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function mul_scal__(self,scal)
 
- class(quaternion), intent(in) :: self
+  class(quaternion), intent(in) :: self
- real(pReal), intent(in) :: scal
+  real(pReal), intent(in) :: scal
+
+  mul_scal__%w = self%w*scal
+  mul_scal__%x = self%x*scal
+  mul_scal__%y = self%y*scal
+  mul_scal__%z = self%z*scal
 
- mul_scal__%w = self%w*scal
- mul_scal__%x = self%x*scal
- mul_scal__%y = self%y*scal
- mul_scal__%z = self%z*scal
-    
 end function mul_scal__
 
 
@@ -262,9 +261,9 @@ end function mul_scal__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function div_quat__(self,other)
 
- class(quaternion), intent(in) :: self, other
+  class(quaternion), intent(in) :: self, other
 
- div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal))
+  div_quat__ = self * (conjg(other)/(abs(other)**2.0_pReal))
 
 end function div_quat__
 
@@ -274,10 +273,10 @@ end function div_quat__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function div_scal__(self,scal)
 
- class(quaternion), intent(in) :: self
+  class(quaternion), intent(in) :: self
- real(pReal), intent(in) :: scal
+  real(pReal), intent(in) :: scal
 
- div_scal__ = [self%w,self%x,self%y,self%z]/scal
+  div_scal__ = [self%w,self%x,self%y,self%z]/scal
 
 end function div_scal__
 
@@ -286,14 +285,12 @@ end function div_scal__
 !> equality of two quaternions
 !---------------------------------------------------------------------------------------------------
 logical elemental function eq__(self,other)
- use prec, only: &
-   dEq
 
- class(quaternion), intent(in) :: self,other
+  class(quaternion), intent(in) :: self,other
+
+  eq__ = all(dEq([ self%w, self%x, self%y, self%z], &
+                 [other%w,other%x,other%y,other%z]))
 
- eq__ = all(dEq([ self%w, self%x, self%y, self%z], &
-                [other%w,other%x,other%y,other%z]))
-    
 end function eq__
 
 
@@ -302,10 +299,10 @@ end function eq__
 !---------------------------------------------------------------------------------------------------
 logical elemental function neq__(self,other)
 
- class(quaternion), intent(in) :: self,other
+  class(quaternion), intent(in) :: self,other
+
+  neq__ = .not. self%eq__(other)
 
- neq__ = .not. self%eq__(other)
-    
 end function neq__
 
 
@@ -314,11 +311,11 @@ end function neq__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function pow_scal__(self,expon)
 
- class(quaternion), intent(in) :: self
+  class(quaternion), intent(in) :: self
- real(pReal), intent(in) :: expon
+  real(pReal), intent(in) :: expon
- 
+
- pow_scal__ = exp(log(self)*expon)
+  pow_scal__ = exp(log(self)*expon)
-    
+
 end function pow_scal__
 
 
@@ -327,11 +324,11 @@ end function pow_scal__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function pow_quat__(self,expon)
 
- class(quaternion), intent(in) :: self
+  class(quaternion), intent(in) :: self
- type(quaternion),  intent(in) :: expon
+  type(quaternion),  intent(in) :: expon
- 
+
- pow_quat__ = exp(log(self)*expon)
+  pow_quat__ = exp(log(self)*expon)
-    
+
 end function pow_quat__
 
 
@@ -341,15 +338,15 @@ end function pow_quat__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function exp__(self)
 
- class(quaternion), intent(in) :: self
+  class(quaternion), intent(in) :: self
- real(pReal)                   :: absImag
+  real(pReal)                   :: absImag
 
- absImag = norm2([self%x, self%y, self%z])
+  absImag = norm2([self%x, self%y, self%z])
 
- exp__ = exp(self%w) * [                 cos(absImag), &
+  exp__ = exp(self%w) * [                 cos(absImag), &
-                        self%x/absImag * sin(absImag), &
+                         self%x/absImag * sin(absImag), &
-                        self%y/absImag * sin(absImag), &
+                         self%y/absImag * sin(absImag), &
-                        self%z/absImag * sin(absImag)]
+                         self%z/absImag * sin(absImag)]
 
 end function exp__
 
@@ -360,16 +357,16 @@ end function exp__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function log__(self)
 
- class(quaternion), intent(in) :: self
+  class(quaternion), intent(in) :: self
- real(pReal)                     :: absImag
+  real(pReal)                   :: absImag
 
- absImag = norm2([self%x, self%y, self%z])
+  absImag = norm2([self%x, self%y, self%z])
+
+  log__ = [log(abs(self)), &
+           self%x/absImag * acos(self%w/abs(self)), &
+           self%y/absImag * acos(self%w/abs(self)), &
+           self%z/absImag * acos(self%w/abs(self))]
 
- log__ = [log(abs(self)), &
-          self%x/absImag * acos(self%w/abs(self)), &
-          self%y/absImag * acos(self%w/abs(self)), &
-          self%z/absImag * acos(self%w/abs(self))]
-    
 end function log__
 
 
@@ -378,10 +375,10 @@ end function log__
 !---------------------------------------------------------------------------------------------------
 real(pReal) elemental function abs__(a)
 
- class(quaternion), intent(in) :: a
+  class(quaternion), intent(in) :: a
+
+  abs__ = norm2([a%w,a%x,a%y,a%z])
 
- abs__ = norm2([a%w,a%x,a%y,a%z])
-    
 end function abs__
 
 
@@ -390,10 +387,10 @@ end function abs__
 !---------------------------------------------------------------------------------------------------
 real(pReal) elemental function dot_product__(a,b)
 
- class(quaternion), intent(in) :: a,b
+  class(quaternion), intent(in) :: a,b
+
+  dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z
 
- dot_product__ = a%w*b%w + a%x*b%x + a%y*b%y + a%z*b%z
-    
 end function dot_product__
 
 
@@ -402,10 +399,10 @@ end function dot_product__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function conjg__(a)
 
- class(quaternion), intent(in) :: a
+  class(quaternion), intent(in) :: a
+
+  conjg__ = quaternion([a%w, -a%x, -a%y, -a%z])
 
- conjg__ = quaternion([a%w, -a%x, -a%y, -a%z])
-    
 end function conjg__
 
 
@@ -414,10 +411,10 @@ end function conjg__
 !---------------------------------------------------------------------------------------------------
 type(quaternion) elemental function quat_homomorphed(a)
 
- class(quaternion), intent(in) :: a
+  class(quaternion), intent(in) :: a
+
+  quat_homomorphed = quaternion(-[a%w,a%x,a%y,a%z])
 
- quat_homomorphed = quaternion(-[a%w,a%x,a%y,a%z])
-    
 end function quat_homomorphed
 
 end module quaternions

src/results.f90

@@ -5,6 +5,9 @@
 !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH
 !--------------------------------------------------------------------------------------------------
 module results
+  use DAMASK_interface
+  use rotations
+  use numerics
   use HDF5_utilities
 #ifdef PETSc
   use PETSC
@@ -55,8 +58,6 @@ module results
 contains
 
 subroutine results_init
-  use DAMASK_interface, only: &
-    getSolverJobName
 
   character(len=pStringLen) :: commandLine
 
@@ -83,9 +84,6 @@ end subroutine results_init
 !> @brief opens the results file to append data
 !--------------------------------------------------------------------------------------------------
 subroutine results_openJobFile
-  use DAMASK_interface, only: &
-    getSolverJobName
-
 
   resultsFile = HDF5_openFile(trim(getSolverJobName())//'.hdf5','a',.true.)
  
@@ -299,18 +297,26 @@ end subroutine results_writeVectorDataset_real
 !--------------------------------------------------------------------------------------------------
 subroutine results_writeTensorDataset_real(group,dataset,label,description,SIunit)
 
-  character(len=*), intent(in)                      :: label,group,description
+  character(len=*), intent(in)                   :: label,group,description
-  character(len=*), intent(in), optional            :: SIunit
+  character(len=*), intent(in), optional         :: SIunit
-  real(pReal),      intent(inout), dimension(:,:,:) :: dataset
+  real(pReal),      intent(in), dimension(:,:,:) :: dataset
   
+  integer :: i 
   integer(HID_T) :: groupHandle
- 
+  real(pReal), dimension(:,:,:), allocatable :: dataset_transposed
+
+
+  allocate(dataset_transposed,mold=dataset)
+  do i=1,size(dataset,3)
+    dataset_transposed(1:3,1:3,i) = transpose(dataset(1:3,1:3,i))
+  enddo
+
   groupHandle = results_openGroup(group)
   
 #ifdef PETSc
-  call HDF5_write(groupHandle,dataset,label,.true.)
+  call HDF5_write(groupHandle,dataset_transposed,label,.true.)
 #else
-  call HDF5_write(groupHandle,dataset,label,.false.)
+  call HDF5_write(groupHandle,dataset_transposed,label,.false.)
 #endif
   
   if (HDF5_objectExists(groupHandle,label)) &
@@ -388,8 +394,6 @@ end subroutine results_writeTensorDataset_int
 !> @brief stores a scalar dataset in a group
 !--------------------------------------------------------------------------------------------------
 subroutine results_writeScalarDataset_rotation(group,dataset,label,description,lattice_structure)
-  use rotations, only: &
-    rotation
 
   character(len=*), intent(in)                  :: label,group,description
   character(len=*), intent(in), optional        :: lattice_structure
@@ -420,9 +424,6 @@ end subroutine results_writeScalarDataset_rotation
 !> @brief adds the unique mapping from spatial position and constituent ID to results
 !--------------------------------------------------------------------------------------------------
 subroutine results_mapping_constituent(phaseAt,memberAt,label)
-  use numerics, only: &
-    worldrank, &
-    worldsize
     
   integer,           dimension(:,:),   intent(in)  :: phaseAt                                       !< phase section at (constituent,element)
   integer,           dimension(:,:,:), intent(in)  :: memberAt                                      !< phase member at (constituent,IP,element)
@@ -558,9 +559,6 @@ end subroutine results_mapping_constituent
 !> @brief adds the unique mapping from spatial position and constituent ID to results
 !--------------------------------------------------------------------------------------------------
 subroutine results_mapping_materialpoint(homogenizationAt,memberAt,label)
-  use numerics, only: &
-    worldrank, &
-    worldsize
     
   integer,           dimension(:),   intent(in)  :: homogenizationAt                                !< homogenization section at (element)
   integer,           dimension(:,:), intent(in)  :: memberAt                                        !< homogenization member at (IP,element)

src/rotations.f90

@@ -46,12 +46,15 @@
 !---------------------------------------------------------------------------------------------------
 
 module rotations
-  use prec, only: &
+  use prec
-    pReal
+  use IO
+  use math
+  use Lambert
   use quaternions
  
   implicit none
   private
+
   type, public :: rotation
     type(quaternion), private :: q
     contains
@@ -148,8 +151,6 @@ end subroutine
 !> @details: rotation is based on unit quaternion or rotation matrix (fallback)
 !---------------------------------------------------------------------------------------------------
 function rotVector(self,v,active)
-  use prec, only: &
-    dEq
     
   real(pReal),                 dimension(3) :: rotVector
   class(rotation), intent(in)               :: self
@@ -260,10 +261,6 @@ end function qu2om
 !> @brief convert unit quaternion to Euler angles
 !---------------------------------------------------------------------------------------------------
 pure function qu2eu(qu) result(eu)
-  use prec, only: &
-    dEq0
-  use math, only: &
-    PI
 
   type(quaternion), intent(in)              :: qu
   real(pReal),                 dimension(3) :: eu
@@ -294,12 +291,6 @@ end function qu2eu
 !> @brief convert unit quaternion to axis angle pair
 !---------------------------------------------------------------------------------------------------
 pure function qu2ax(qu) result(ax)
-  use prec, only: &
-    dEq0, &
-    dNeq0
-  use math, only: &
-    PI, &
-    math_clip
 
   type(quaternion), intent(in)              :: qu
   real(pReal),                 dimension(4) :: ax
@@ -324,13 +315,6 @@ end function qu2ax
 !> @brief convert unit quaternion to Rodrigues vector
 !---------------------------------------------------------------------------------------------------
 pure function qu2ro(qu) result(ro)
-  use, intrinsic :: IEEE_ARITHMETIC, only: &
-    IEEE_value, &
-    IEEE_positive_inf
-  use prec, only: &
-    dEq0
-  use math, only: &
-    math_clip
   
   type(quaternion), intent(in)              :: qu
   real(pReal),                 dimension(4) :: ro
@@ -358,10 +342,6 @@ end function qu2ro
 !> @brief convert unit quaternion to homochoric
 !---------------------------------------------------------------------------------------------------
 pure function qu2ho(qu) result(ho)
-  use prec, only: &
-    dEq0
-  use math, only: &
-    math_clip
 
   type(quaternion), intent(in)               :: qu
   real(pReal),                  dimension(3) :: ho
@@ -415,8 +395,6 @@ end function om2qu
 !> @brief orientation matrix to Euler angles
 !---------------------------------------------------------------------------------------------------
 pure function om2eu(om) result(eu)
-  use math, only: &
-    PI
 
   real(pReal), intent(in), dimension(3,3) :: om
   real(pReal),             dimension(3)   :: eu
@@ -441,15 +419,6 @@ end function om2eu
 !> @brief convert orientation matrix to axis angle pair
 !---------------------------------------------------------------------------------------------------
 function om2ax(om) result(ax)
-  use prec, only: &
-    dEq0, &
-    cEq, &
-    dNeq0
-  use IO, only: &
-    IO_error
-  use math, only: &
-    math_clip, &
-    math_trace33
 
   real(pReal), intent(in)     :: om(3,3)
   real(pReal)                 :: ax(4)
@@ -560,8 +529,6 @@ end function eu2qu
 !> @brief Euler angles to orientation matrix
 !---------------------------------------------------------------------------------------------------
 pure function eu2om(eu) result(om)
-  use prec, only: &
-    dEq0
   
   real(pReal), intent(in), dimension(3)   :: eu
   real(pReal),             dimension(3,3) :: om
@@ -591,11 +558,6 @@ end function eu2om
 !> @brief convert euler to axis angle
 !---------------------------------------------------------------------------------------------------
 pure function eu2ax(eu) result(ax)
-  use prec, only: &
-    dEq0, &
-    dEq
-  use math, only: &
-    PI
  
   real(pReal), intent(in), dimension(3) :: eu
   real(pReal),             dimension(4) :: ax
@@ -625,13 +587,6 @@ end function eu2ax
 !> @brief Euler angles to Rodrigues vector
 !---------------------------------------------------------------------------------------------------
 pure function eu2ro(eu) result(ro)
-  use prec, only: &
-    dEq0
-  use, intrinsic :: IEEE_ARITHMETIC, only: &
-    IEEE_value, &
-    IEEE_positive_inf
-  use math, only: &
-    PI
 
   real(pReal), intent(in), dimension(3) :: eu
   real(pReal),             dimension(4) :: ro
@@ -681,8 +636,6 @@ end function eu2cu
 !> @brief convert axis angle pair to quaternion
 !---------------------------------------------------------------------------------------------------
 pure function ax2qu(ax) result(qu)
-  use prec, only: &
-    dEq0
     
   real(pReal),      intent(in), dimension(4) :: ax
   type(quaternion)                           :: qu
@@ -755,13 +708,6 @@ end function ax2eu
 !> @brief convert axis angle pair to Rodrigues vector
 !---------------------------------------------------------------------------------------------------
 pure function ax2ro(ax) result(ro)
-  use, intrinsic :: IEEE_ARITHMETIC, only: &
-    IEEE_value, &
-    IEEE_positive_inf
-  use prec, only: &
-    dEq0
-  use math, only: &
-    PI
 
   real(pReal), intent(in), dimension(4) :: ax
   real(pReal),             dimension(4) :: ro
@@ -858,12 +804,6 @@ end function ro2eu
 !> @brief convert Rodrigues vector to axis angle pair
 !---------------------------------------------------------------------------------------------------
 pure function ro2ax(ro) result(ax)
-  use, intrinsic :: IEEE_ARITHMETIC, only: &
-    IEEE_is_finite
-  use prec, only: &
-    dEq0
-  use math, only: &
-    PI
 
   real(pReal), intent(in), dimension(4) :: ro
   real(pReal),             dimension(4) :: ax
@@ -890,12 +830,6 @@ end function ro2ax
 !> @brief convert Rodrigues vector to homochoric
 !---------------------------------------------------------------------------------------------------
 pure function ro2ho(ro) result(ho)
-  use, intrinsic :: IEEE_ARITHMETIC, only: &
-    IEEE_is_finite
-  use prec, only: &
-    dEq0
-  use math, only: &
-    PI
 
   real(pReal),        intent(in), dimension(4) :: ro
   real(pReal),                    dimension(3) :: ho
@@ -973,8 +907,6 @@ end function ho2eu
 !> @brief convert homochoric to axis angle pair
 !---------------------------------------------------------------------------------------------------
 pure function ho2ax(ho) result(ax)
-  use prec, only: &
-    dEq0
 
   real(pReal), intent(in), dimension(3) :: ho
   real(pReal),             dimension(4) :: ax
@@ -1029,13 +961,11 @@ end function ho2ro
 !> @brief convert homochoric to cubochoric
 !---------------------------------------------------------------------------------------------------
 function ho2cu(ho) result(cu)
-  use Lambert, only: &
-    LambertBallToCube
 
   real(pReal), intent(in), dimension(3) :: ho
   real(pReal),             dimension(3) :: cu
 
-  cu = LambertBallToCube(ho)
+  cu = Lambert_BallToCube(ho)
 
 end function ho2cu
 
@@ -1115,13 +1045,11 @@ end function cu2ro
 !> @brief convert cubochoric to homochoric
 !---------------------------------------------------------------------------------------------------
 function cu2ho(cu) result(ho)
-  use Lambert, only: &
-    LambertCubeToBall
 
   real(pReal), intent(in), dimension(3) :: cu
   real(pReal),             dimension(3) :: ho
 
-  ho = LambertCubeToBall(cu)
+  ho = Lambert_CubeToBall(cu)
 
 end function cu2ho
 

src/source_damage_anisoBrittle.f90

@@ -5,57 +5,62 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module source_damage_anisoBrittle
- use prec, only: &
+  use prec
-   pReal, &
+  use debug
-   pInt
+  use IO
+  use math
+  use material
+  use config
+  use lattice
 
- implicit none
+  implicit none
- private
+  private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
-   source_damage_anisoBrittle_offset, &                                                                         !< which source is my current source mechanism?
-   source_damage_anisoBrittle_instance                                                                          !< instance of source mechanism
 
- integer(pInt),                       dimension(:,:),         allocatable, target, public  :: &
+  integer,                       dimension(:),           allocatable,         public, protected :: &
-   source_damage_anisoBrittle_sizePostResult                                                                    !< size of each post result output
+    source_damage_anisoBrittle_offset, &                                                            !< which source is my current source mechanism?
+    source_damage_anisoBrittle_instance                                                             !< instance of source mechanism
 
- character(len=64),                   dimension(:,:),         allocatable, target, public  :: &
+  integer,                       dimension(:,:),         allocatable, target, public  :: &
-   source_damage_anisoBrittle_output                                                                            !< name of each post result output
+    source_damage_anisoBrittle_sizePostResult                                                       !< size of each post result output
-   
- integer(pInt),                       dimension(:,:),         allocatable,         private :: &
-   source_damage_anisoBrittle_Ncleavage                                                                         !< number of cleavage systems per family
 
- enum, bind(c) 
+  character(len=64),             dimension(:,:),         allocatable, target, public  :: &
-   enumerator :: undefined_ID, &
+    source_damage_anisoBrittle_output                                                               !< name of each post result output
-                 damage_drivingforce_ID
+    
- end enum                                                
+  integer,                       dimension(:,:),         allocatable :: &
+    source_damage_anisoBrittle_Ncleavage                                                            !< number of cleavage systems per family
+
+  enum, bind(c) 
+    enumerator :: undefined_ID, &
+                  damage_drivingforce_ID
+  end enum                                                
 
 
- type, private :: tParameters                                                                       !< container type for internal constitutive parameters
+  type :: tParameters                                                                                !< container type for internal constitutive parameters
-   real(pReal) :: &
+    real(pReal) :: &
-     aTol, &
+      aTol, &
-     sdot_0, &
+      sdot_0, &
-     N
+      N
-   real(pReal), dimension(:), allocatable :: &
+    real(pReal), dimension(:), allocatable :: &
-     critDisp, &
+      critDisp, &
-     critLoad
+      critLoad
-   real(pReal), dimension(:,:,:,:), allocatable :: &
+    real(pReal), dimension(:,:,:,:), allocatable :: &
-     cleavage_systems
+      cleavage_systems
-   integer(pInt) :: &
+    integer :: &
-     totalNcleavage
+      totalNcleavage
-   integer(pInt), dimension(:), allocatable :: &
+    integer, dimension(:), allocatable :: &
-     Ncleavage
+      Ncleavage
-   integer(kind(undefined_ID)), allocatable, dimension(:) :: &
+    integer(kind(undefined_ID)), allocatable, dimension(:) :: &
-     outputID                                                                                       !< ID of each post result output
+      outputID                                                                                      !< ID of each post result output
- end type tParameters
+  end type tParameters
 
- type(tParameters), dimension(:), allocatable, private :: param                                     !< containers of constitutive parameters (len Ninstance)
+  type(tParameters), dimension(:), allocatable :: param                                             !< containers of constitutive parameters (len Ninstance)
 
 
- public :: &
+  public :: &
-   source_damage_anisoBrittle_init, &
+    source_damage_anisoBrittle_init, &
-   source_damage_anisoBrittle_dotState, &
+    source_damage_anisoBrittle_dotState, &
-   source_damage_anisobrittle_getRateAndItsTangent, &
+    source_damage_anisobrittle_getRateAndItsTangent, &
-   source_damage_anisoBrittle_postResults
+    source_damage_anisoBrittle_postResults
 
 contains
 
@@ -65,268 +70,230 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine source_damage_anisoBrittle_init
- use prec, only: &
-   pStringLen
- use debug, only: &
-   debug_level,&
-   debug_constitutive,&
-   debug_levelBasic
- use IO, only: &
-   IO_error
-    use math, only: &
-   math_expand
- use material, only: &
-   material_allocateSourceState, &
-   phase_source, &
-   phase_Nsources, &
-   phase_Noutput, &
-   SOURCE_damage_anisoBrittle_label, &
-   SOURCE_damage_anisoBrittle_ID, &
-   material_phase, &
-   sourceState
- use config, only: &
-   config_phase, &
-   material_Nphase
- use lattice, only: &
-   lattice_SchmidMatrix_cleavage, &
-   lattice_maxNcleavageFamily
 
- integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
+  integer :: Ninstance,phase,instance,source,sourceOffset
- integer(pInt) :: NofMyPhase,p   ,i
+  integer :: NofMyPhase,p   ,i
- integer(pInt),          dimension(0), parameter :: emptyIntArray    = [integer(pInt)::]
+  integer,              dimension(0), parameter :: emptyIntArray    = [integer::]
- character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
+  character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
- integer(kind(undefined_ID)) :: &
+  integer(kind(undefined_ID)) :: &
-   outputID
+    outputID
 
- character(len=pStringLen) :: &
+  character(len=pStringLen) :: &
-   extmsg = ''
+    extmsg = ''
- character(len=65536), dimension(:), allocatable :: &
+  character(len=65536), dimension(:), allocatable :: &
-   outputs
+    outputs
 
- write(6,'(/,a)')   ' <<<+-  source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init  -+>>>'
+  write(6,'(/,a)')   ' <<<+-  source_'//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//' init  -+>>>'
 
- Ninstance = int(count(phase_source == SOURCE_damage_anisoBrittle_ID),pInt)
+  Ninstance = count(phase_source == SOURCE_damage_anisoBrittle_ID)
- if (Ninstance == 0_pInt) return
+  if (Ninstance == 0) return
- 
+  
- if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
+  if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
-   write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
+    write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
- 
+  
- allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0_pInt)
+  allocate(source_damage_anisoBrittle_offset(material_Nphase), source=0)
- allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0_pInt)
+  allocate(source_damage_anisoBrittle_instance(material_Nphase), source=0)
- do phase = 1, material_Nphase
+  do phase = 1, material_Nphase
-   source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID)
+    source_damage_anisoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoBrittle_ID)
-   do source = 1, phase_Nsources(phase)
+    do source = 1, phase_Nsources(phase)
-     if (phase_source(source,phase) == source_damage_anisoBrittle_ID) &
+      if (phase_source(source,phase) == source_damage_anisoBrittle_ID) &
-       source_damage_anisoBrittle_offset(phase) = source
+        source_damage_anisoBrittle_offset(phase) = source
-   enddo    
+    enddo    
- enddo
+  enddo
- 
+  
- allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0_pInt)
+  allocate(source_damage_anisoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance), source=0)
- allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance))
+  allocate(source_damage_anisoBrittle_output(maxval(phase_Noutput),Ninstance))
-          source_damage_anisoBrittle_output = ''
+           source_damage_anisoBrittle_output = ''
 
- allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0_pInt)
+  allocate(source_damage_anisoBrittle_Ncleavage(lattice_maxNcleavageFamily,Ninstance), source=0)
 
- allocate(param(Ninstance))
+  allocate(param(Ninstance))
- 
+  
- do p=1, size(config_phase)
+  do p=1, size(config_phase)
-   if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISOBRITTLE_ID)) cycle
+    if (all(phase_source(:,p) /= SOURCE_DAMAGE_ANISOBRITTLE_ID)) cycle
-   associate(prm => param(source_damage_anisoBrittle_instance(p)), &
+    associate(prm => param(source_damage_anisoBrittle_instance(p)), &
-             config => config_phase(p))
+              config => config_phase(p))
-             
+              
-   prm%aTol      = config%getFloat('anisobrittle_atol',defaultVal = 1.0e-3_pReal)
+    prm%aTol      = config%getFloat('anisobrittle_atol',defaultVal = 1.0e-3_pReal)
 
-   prm%N         = config%getFloat('anisobrittle_ratesensitivity')
+    prm%N         = config%getFloat('anisobrittle_ratesensitivity')
-   prm%sdot_0    = config%getFloat('anisobrittle_sdot0')
+    prm%sdot_0    = config%getFloat('anisobrittle_sdot0')
-   
+    
-   ! sanity checks
+    ! sanity checks
-   if (prm%aTol      < 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_atol'
+    if (prm%aTol      < 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_atol'
-   
+    
-   if (prm%N        <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_ratesensitivity'
+    if (prm%N        <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_ratesensitivity'
-   if (prm%sdot_0   <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0'
+    if (prm%sdot_0   <= 0.0_pReal) extmsg = trim(extmsg)//' anisobrittle_sdot0'
-   
+    
-   prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray)
+    prm%Ncleavage = config%getInts('ncleavage',defaultVal=emptyIntArray)
 
-   prm%critDisp = config%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(prm%Ncleavage))
+    prm%critDisp = config%getFloats('anisobrittle_criticaldisplacement',requiredSize=size(prm%Ncleavage))
-   prm%critLoad = config%getFloats('anisobrittle_criticalload',        requiredSize=size(prm%Ncleavage))
+    prm%critLoad = config%getFloats('anisobrittle_criticalload',        requiredSize=size(prm%Ncleavage))
-   
+    
-   prm%cleavage_systems  = lattice_SchmidMatrix_cleavage (prm%Ncleavage,config%getString('lattice_structure'),&
+    prm%cleavage_systems  = lattice_SchmidMatrix_cleavage (prm%Ncleavage,config%getString('lattice_structure'),&
-                                                    config%getFloat('c/a',defaultVal=0.0_pReal))
+                                                     config%getFloat('c/a',defaultVal=0.0_pReal))
 
-     ! expand: family => system
+      ! expand: family => system
-     prm%critDisp  = math_expand(prm%critDisp, prm%Ncleavage)
+      prm%critDisp  = math_expand(prm%critDisp, prm%Ncleavage)
-     prm%critLoad  = math_expand(prm%critLoad, prm%Ncleavage)
+      prm%critLoad  = math_expand(prm%critLoad, prm%Ncleavage)
-     
+      
-     if (any(prm%critLoad < 0.0_pReal))     extmsg = trim(extmsg)//' anisobrittle_criticalload'
+      if (any(prm%critLoad < 0.0_pReal))     extmsg = trim(extmsg)//' anisobrittle_criticalload'
-    if (any(prm%critDisp < 0.0_pReal))     extmsg = trim(extmsg)//' anisobrittle_criticaldisplacement'  
+     if (any(prm%critDisp < 0.0_pReal))     extmsg = trim(extmsg)//' anisobrittle_criticaldisplacement'  
 !--------------------------------------------------------------------------------------------------
 !  exit if any parameter is out of range
-   if (extmsg /= '') &
+    if (extmsg /= '') &
-     call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')')
+      call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISOBRITTLE_LABEL//')')
 
 !--------------------------------------------------------------------------------------------------
 !  output pararameters
-   outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
+    outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
-   allocate(prm%outputID(0))
+    allocate(prm%outputID(0))
-   do i=1_pInt, size(outputs)
+    do i=1, size(outputs)
-     outputID = undefined_ID
+      outputID = undefined_ID
-     select case(outputs(i))
+      select case(outputs(i))
-     
+      
-       case ('anisobrittle_drivingforce')
+        case ('anisobrittle_drivingforce')
-         source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1_pInt
+          source_damage_anisoBrittle_sizePostResult(i,source_damage_anisoBrittle_instance(p)) = 1
-         source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i)
+          source_damage_anisoBrittle_output(i,source_damage_anisoBrittle_instance(p)) = outputs(i)
-         prm%outputID = [prm%outputID, damage_drivingforce_ID]
+          prm%outputID = [prm%outputID, damage_drivingforce_ID]
 
-     end select
+      end select
 
-   enddo
+    enddo
 
-   end associate
+    end associate
-   
+    
-   phase = p
+    phase = p
-   NofMyPhase=count(material_phase==phase)
+    NofMyPhase=count(material_phase==phase)
-   instance = source_damage_anisoBrittle_instance(phase)
+    instance = source_damage_anisoBrittle_instance(phase)
-   sourceOffset = source_damage_anisoBrittle_offset(phase)
+    sourceOffset = source_damage_anisoBrittle_offset(phase)
 
 
-   call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt)
+    call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0)
-   sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance))
+    sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoBrittle_sizePostResult(:,instance))
-   sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
+    sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
 
 
-   source_damage_anisoBrittle_Ncleavage(1:size(param(instance)%Ncleavage),instance) = param(instance)%Ncleavage
+    source_damage_anisoBrittle_Ncleavage(1:size(param(instance)%Ncleavage),instance) = param(instance)%Ncleavage
- enddo
+  enddo
 
- 
 end subroutine source_damage_anisoBrittle_init
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief calculates derived quantities from state
 !--------------------------------------------------------------------------------------------------
 subroutine source_damage_anisoBrittle_dotState(S, ipc, ip, el)
- use math, only: &
-   math_mul33xx33
- use material, only: &
-   phaseAt, phasememberAt, &
-   sourceState, &
-   material_homogenizationAt, &
-   damage, &
-   damageMapping
- use lattice, only: &
-   lattice_Scleavage, &
-   lattice_maxNcleavageFamily, &
-   lattice_NcleavageSystem
 
- integer(pInt), intent(in) :: &
+  integer, intent(in) :: &
-   ipc, &                                                                                           !< component-ID of integration point
+    ipc, &                                                                                          !< component-ID of integration point
-   ip, &                                                                                            !< integration point
+    ip, &                                                                                           !< integration point
-   el                                                                                               !< element
+    el                                                                                              !< element
- real(pReal),  intent(in), dimension(3,3) :: &
+  real(pReal),  intent(in), dimension(3,3) :: &
-   S
+    S
- integer(pInt) :: &
+  integer :: &
-   phase, &
+    phase, &
-   constituent, &
+    constituent, &
-   instance, &
+    instance, &
-   sourceOffset, &
+    sourceOffset, &
-   damageOffset, &
+    damageOffset, &
-   homog, &
+    homog, &
-   f, i, index_myFamily, index
+    f, i, index_myFamily, index
- real(pReal) :: &
+  real(pReal) :: &
-   traction_d, traction_t, traction_n, traction_crit
+    traction_d, traction_t, traction_n, traction_crit
 
- phase = phaseAt(ipc,ip,el)
+  phase = phaseAt(ipc,ip,el)
- constituent = phasememberAt(ipc,ip,el)
+  constituent = phasememberAt(ipc,ip,el)
- instance = source_damage_anisoBrittle_instance(phase)
+  instance = source_damage_anisoBrittle_instance(phase)
- sourceOffset = source_damage_anisoBrittle_offset(phase)
+  sourceOffset = source_damage_anisoBrittle_offset(phase)
- homog = material_homogenizationAt(el)
+  homog = material_homogenizationAt(el)
- damageOffset = damageMapping(homog)%p(ip,el)
+  damageOffset = damageMapping(homog)%p(ip,el)
- 
+  
- sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal
+  sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = 0.0_pReal
- 
+  
- index = 1_pInt
+  index = 1
- do f = 1_pInt,lattice_maxNcleavageFamily
+  do f = 1,lattice_maxNcleavageFamily
-   index_myFamily = sum(lattice_NcleavageSystem(1:f-1_pInt,phase))                                  ! at which index starts my family
+    index_myFamily = sum(lattice_NcleavageSystem(1:f-1,phase))                                      ! at which index starts my family
-   do i = 1_pInt,source_damage_anisoBrittle_Ncleavage(f,instance)                                   ! process each (active) cleavage system in family
+    do i = 1,source_damage_anisoBrittle_Ncleavage(f,instance)                                       ! process each (active) cleavage system in family
 
-     traction_d    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase))
+      traction_d    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,1,index_myFamily+i,phase))
-     traction_t    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase))
+      traction_t    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,2,index_myFamily+i,phase))
-     traction_n    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase))
+      traction_n    = math_mul33xx33(S,lattice_Scleavage(1:3,1:3,3,index_myFamily+i,phase))
-     
+      
-     traction_crit = param(instance)%critLoad(index)* &
+      traction_crit = param(instance)%critLoad(index)* &
-                     damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset)
+                      damage(homog)%p(damageOffset)*damage(homog)%p(damageOffset)
 
-     sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = &
+      sourceState(phase)%p(sourceOffset)%dotState(1,constituent) = &
-       sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + &
+        sourceState(phase)%p(sourceOffset)%dotState(1,constituent) + &
-       param(instance)%sdot_0* &
+        param(instance)%sdot_0* &
-       ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + &
+        ((max(0.0_pReal, abs(traction_d) - traction_crit)/traction_crit)**param(instance)%N + &
-        (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + &
+         (max(0.0_pReal, abs(traction_t) - traction_crit)/traction_crit)**param(instance)%N + &
-        (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ &
+         (max(0.0_pReal, abs(traction_n) - traction_crit)/traction_crit)**param(instance)%N)/ &
-       param(instance)%critDisp(index)
+        param(instance)%critDisp(index)
 
-   index = index + 1_pInt
+    index = index + 1
-   enddo
+    enddo
- enddo
+  enddo
 
 end subroutine source_damage_anisoBrittle_dotState
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief returns local part of nonlocal damage driving force
 !--------------------------------------------------------------------------------------------------
 subroutine source_damage_anisobrittle_getRateAndItsTangent(localphiDot, dLocalphiDot_dPhi, phi, phase, constituent)
- use material, only: &
-   sourceState
 
- integer(pInt), intent(in) :: &
+  integer, intent(in) :: &
-   phase, &
+    phase, &
-   constituent
+    constituent
- real(pReal),  intent(in) :: &
+  real(pReal),  intent(in) :: &
-   phi
+    phi
- real(pReal),  intent(out) :: &
+  real(pReal),  intent(out) :: &
-   localphiDot, &
+    localphiDot, &
-   dLocalphiDot_dPhi
+    dLocalphiDot_dPhi
- integer(pInt) :: &
+  integer :: &
-   sourceOffset
+    sourceOffset
 
- sourceOffset = source_damage_anisoBrittle_offset(phase)
+  sourceOffset = source_damage_anisoBrittle_offset(phase)
- 
+  
- localphiDot = 1.0_pReal &
+  localphiDot = 1.0_pReal &
-             - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi
+              - sourceState(phase)%p(sourceOffset)%state(1,constituent)*phi
- 
+  
- dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
+  dLocalphiDot_dPhi = -sourceState(phase)%p(sourceOffset)%state(1,constituent)
  
 end subroutine source_damage_anisobrittle_getRateAndItsTangent
- 
+
+
 !--------------------------------------------------------------------------------------------------
 !> @brief return array of local damage results
 !--------------------------------------------------------------------------------------------------
 function source_damage_anisoBrittle_postResults(phase, constituent)
- use material, only: &
-   sourceState
 
- integer(pInt), intent(in) :: &
+  integer, intent(in) :: &
-   phase, &
+    phase, &
-   constituent
+    constituent
- real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, &
-                          source_damage_anisoBrittle_instance(phase)))) :: &
-   source_damage_anisoBrittle_postResults
 
- integer(pInt) :: &
+  real(pReal), dimension(sum(source_damage_anisoBrittle_sizePostResult(:, &
-   instance, sourceOffset, o, c
+                           source_damage_anisoBrittle_instance(phase)))) :: &
-   
+    source_damage_anisoBrittle_postResults
- instance = source_damage_anisoBrittle_instance(phase)
- sourceOffset = source_damage_anisoBrittle_offset(phase)
 
- c = 0_pInt
+  integer :: &
+    instance, sourceOffset, o, c
+    
+  instance = source_damage_anisoBrittle_instance(phase)
+  sourceOffset = source_damage_anisoBrittle_offset(phase)
 
- do o = 1_pInt,size(param(instance)%outputID)
+  c = 0
-    select case(param(instance)%outputID(o))
-      case (damage_drivingforce_ID)
-        source_damage_anisoBrittle_postResults(c+1_pInt) = &
-          sourceState(phase)%p(sourceOffset)%state(1,constituent)
-        c = c + 1_pInt
 
-    end select
+  do o = 1,size(param(instance)%outputID)
- enddo
+     select case(param(instance)%outputID(o))
+       case (damage_drivingforce_ID)
+         source_damage_anisoBrittle_postResults(c+1) = &
+           sourceState(phase)%p(sourceOffset)%state(1,constituent)
+         c = c + 1
+
+     end select
+  enddo
 end function source_damage_anisoBrittle_postResults
 
 end module source_damage_anisoBrittle

src/source_damage_anisoDuctile.f90

@@ -5,20 +5,18 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module source_damage_anisoDuctile
- use prec, only: &
+ use prec
-   pReal, &
-   pInt
 
  implicit none
  private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
+ integer,                       dimension(:),           allocatable,         public, protected :: &
    source_damage_anisoDuctile_offset, &                                                                         !< which source is my current damage mechanism?
    source_damage_anisoDuctile_instance                                                                          !< instance of damage source mechanism
 
- integer(pInt),                       dimension(:,:),         allocatable, target, public  :: &
+ integer,                       dimension(:,:),         allocatable, target, public  :: &
    source_damage_anisoDuctile_sizePostResult                                                                    !< size of each post result output
 
- character(len=64),                   dimension(:,:),         allocatable, target, public  :: &
+ character(len=64),             dimension(:,:),         allocatable, target, public  :: &
    source_damage_anisoDuctile_output                                                                            !< name of each post result output
    
 
@@ -59,8 +57,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine source_damage_anisoDuctile_init
- use prec, only: &
-   pStringLen
  use debug, only: &
    debug_level,&
    debug_constitutive,&
@@ -82,11 +78,11 @@ subroutine source_damage_anisoDuctile_init
    config_phase
 
    
- integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
+ integer :: Ninstance,phase,instance,source,sourceOffset
- integer(pInt) :: NofMyPhase,p ,i
+ integer :: NofMyPhase,p ,i
 
- integer(pInt),          dimension(0), parameter :: emptyIntArray    = [integer(pInt)::]
+ integer,              dimension(0), parameter :: emptyIntArray    = [integer::]
- character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
+ character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
  integer(kind(undefined_ID)) :: &
    outputID
 
@@ -98,13 +94,13 @@ subroutine source_damage_anisoDuctile_init
  write(6,'(/,a)')   ' <<<+-  source_'//SOURCE_DAMAGE_ANISODUCTILE_LABEL//' init  -+>>>'
 
  Ninstance = count(phase_source == SOURCE_damage_anisoDuctile_ID)
- if (Ninstance == 0_pInt) return
+ if (Ninstance == 0) return
  
- if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
+ if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
    write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
  
- allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0_pInt)
+ allocate(source_damage_anisoDuctile_offset(size(config_phase)), source=0)
- allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0_pInt)
+ allocate(source_damage_anisoDuctile_instance(size(config_phase)), source=0)
  do phase = 1, size(config_phase)
    source_damage_anisoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_anisoDuctile_ID)
    do source = 1, phase_Nsources(phase)
@@ -113,7 +109,7 @@ subroutine source_damage_anisoDuctile_init
    enddo    
  enddo
    
- allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
+ allocate(source_damage_anisoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0)
  allocate(source_damage_anisoDuctile_output(maxval(phase_Noutput),Ninstance))
           source_damage_anisoDuctile_output = ''
 
@@ -146,18 +142,18 @@ subroutine source_damage_anisoDuctile_init
 !--------------------------------------------------------------------------------------------------
 !  exit if any parameter is out of range
    if (extmsg /= '') &
-     call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')')
+     call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ANISODUCTILE_LABEL//')')
 
 !--------------------------------------------------------------------------------------------------
 !  output pararameters
    outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
    allocate(prm%outputID(0))
-   do i=1_pInt, size(outputs)
+   do i=1, size(outputs)
      outputID = undefined_ID
      select case(outputs(i))
      
        case ('anisoductile_drivingforce')
-         source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1_pInt
+         source_damage_anisoDuctile_sizePostResult(i,source_damage_anisoDuctile_instance(p)) = 1
          source_damage_anisoDuctile_output(i,source_damage_anisoDuctile_instance(p)) = outputs(i)
          prm%outputID = [prm%outputID, damage_drivingforce_ID]
 
@@ -173,7 +169,7 @@ subroutine source_damage_anisoDuctile_init
    instance = source_damage_anisoDuctile_instance(phase)
    sourceOffset = source_damage_anisoDuctile_offset(phase)
 
-   call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt)
+   call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0)
    sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_anisoDuctile_sizePostResult(:,instance))
    sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
    
@@ -193,11 +189,11 @@ subroutine source_damage_anisoDuctile_dotState(ipc, ip, el)
    damage, &
    damageMapping
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    ipc, &                                                                                           !< component-ID of integration point
    ip, &                                                                                            !< integration point
    el                                                                                               !< element
- integer(pInt) :: &
+ integer :: &
    phase, &
    constituent, &
    sourceOffset, &
@@ -229,7 +225,7 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph
  use material, only: &
    sourceState
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    phase, &
    constituent
  real(pReal),  intent(in) :: &
@@ -237,7 +233,7 @@ subroutine source_damage_anisoDuctile_getRateAndItsTangent(localphiDot, dLocalph
  real(pReal),  intent(out) :: &
    localphiDot, &
    dLocalphiDot_dPhi
- integer(pInt) :: &
+ integer :: &
    sourceOffset
 
  sourceOffset = source_damage_anisoDuctile_offset(phase)
@@ -256,27 +252,27 @@ function source_damage_anisoDuctile_postResults(phase, constituent)
  use material, only: &
    sourceState
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    phase, &
    constituent
  real(pReal), dimension(sum(source_damage_anisoDuctile_sizePostResult(:, &
                           source_damage_anisoDuctile_instance(phase)))) :: &
    source_damage_anisoDuctile_postResults
 
- integer(pInt) :: &
+ integer :: &
    instance, sourceOffset, o, c
    
  instance = source_damage_anisoDuctile_instance(phase)
  sourceOffset = source_damage_anisoDuctile_offset(phase)
 
- c = 0_pInt
+ c = 0
 
- do o = 1_pInt,size(param(instance)%outputID)
+ do o = 1,size(param(instance)%outputID)
     select case(param(instance)%outputID(o))
       case (damage_drivingforce_ID)
-        source_damage_anisoDuctile_postResults(c+1_pInt) = &
+        source_damage_anisoDuctile_postResults(c+1) = &
           sourceState(phase)%p(sourceOffset)%state(1,constituent)
-        c = c + 1_pInt
+        c = c + 1
 
     end select
  enddo

src/source_damage_isoBrittle.f90

@@ -5,20 +5,18 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module source_damage_isoBrittle
- use prec, only: &
+ use prec
-   pReal, &
-   pInt
 
  implicit none
  private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
+ integer,                       dimension(:),           allocatable,         public, protected :: &
    source_damage_isoBrittle_offset, &                                                                 !< which source is my current damage mechanism?
    source_damage_isoBrittle_instance                                                                  !< instance of damage source mechanism
 
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
+ integer,                       dimension(:,:),         allocatable, target, public :: &
    source_damage_isoBrittle_sizePostResult                                                            !< size of each post result output
 
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
+ character(len=64),             dimension(:,:),         allocatable, target, public :: &
    source_damage_isoBrittle_output                                                                    !< name of each post result output
 
  enum, bind(c) 
@@ -53,8 +51,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine source_damage_isoBrittle_init
- use prec, only: &
-   pStringLen
  use debug, only: &
    debug_level,&
    debug_constitutive,&
@@ -75,9 +71,9 @@ subroutine source_damage_isoBrittle_init
    material_Nphase
 
 
- integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
+ integer :: Ninstance,phase,instance,source,sourceOffset
- integer(pInt) :: NofMyPhase,p,i   
+ integer :: NofMyPhase,p,i   
- character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
+ character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
  integer(kind(undefined_ID)) :: &
    outputID
 
@@ -88,14 +84,14 @@ subroutine source_damage_isoBrittle_init
  
  write(6,'(/,a)')   ' <<<+-  source_'//SOURCE_DAMAGE_ISOBRITTLE_LABEL//' init  -+>>>'
 
- Ninstance = int(count(phase_source == SOURCE_damage_isoBrittle_ID),pInt)
+ Ninstance = count(phase_source == SOURCE_damage_isoBrittle_ID)
- if (Ninstance == 0_pInt) return
+ if (Ninstance == 0) return
  
- if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) &
+ if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
    write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
  
- allocate(source_damage_isoBrittle_offset(material_Nphase), source=0_pInt)
+ allocate(source_damage_isoBrittle_offset(material_Nphase), source=0)
- allocate(source_damage_isoBrittle_instance(material_Nphase), source=0_pInt)
+ allocate(source_damage_isoBrittle_instance(material_Nphase), source=0)
  do phase = 1, material_Nphase
    source_damage_isoBrittle_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoBrittle_ID)
    do source = 1, phase_Nsources(phase)
@@ -104,7 +100,7 @@ subroutine source_damage_isoBrittle_init
    enddo    
  enddo
    
- allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
+ allocate(source_damage_isoBrittle_sizePostResult(maxval(phase_Noutput),Ninstance),source=0)
  allocate(source_damage_isoBrittle_output(maxval(phase_Noutput),Ninstance))
           source_damage_isoBrittle_output = ''
 
@@ -129,18 +125,18 @@ subroutine source_damage_isoBrittle_init
 !--------------------------------------------------------------------------------------------------
 !  exit if any parameter is out of range
    if (extmsg /= '') &
-     call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')')
+     call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISOBRITTLE_LABEL//')')
 
 !--------------------------------------------------------------------------------------------------
 !  output pararameters
    outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
    allocate(prm%outputID(0))
-   do i=1_pInt, size(outputs)
+   do i=1, size(outputs)
      outputID = undefined_ID
      select case(outputs(i))
      
        case ('isobrittle_drivingforce')
-         source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1_pInt
+         source_damage_isoBrittle_sizePostResult(i,source_damage_isoBrittle_instance(p)) = 1
          source_damage_isoBrittle_output(i,source_damage_isoBrittle_instance(p)) = outputs(i)
          prm%outputID = [prm%outputID, damage_drivingforce_ID]
            
@@ -156,7 +152,7 @@ subroutine source_damage_isoBrittle_init
   instance = source_damage_isoBrittle_instance(phase)
   sourceOffset = source_damage_isoBrittle_offset(phase)
      
-  call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,1_pInt)
+  call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,1)
   sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoBrittle_sizePostResult(:,instance))
   sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
  
@@ -175,7 +171,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
    math_sym33to6, &
    math_I3
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    ipc, &                                                                                           !< component-ID of integration point
    ip, &                                                                                            !< integration point
    el                                                                                               !< element
@@ -183,7 +179,7 @@ subroutine source_damage_isoBrittle_deltaState(C, Fe, ipc, ip, el)
    Fe
  real(pReal),  intent(in), dimension(6,6) :: &
    C
- integer(pInt) :: &
+ integer :: &
    phase, constituent, instance, sourceOffset
  real(pReal) :: &
    strain(6), &
@@ -219,7 +215,7 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD
  use material, only: &
    sourceState
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    phase, &
    constituent
  real(pReal),  intent(in) :: &
@@ -227,7 +223,7 @@ subroutine source_damage_isoBrittle_getRateAndItsTangent(localphiDot, dLocalphiD
  real(pReal),  intent(out) :: &
    localphiDot, &
    dLocalphiDot_dPhi
- integer(pInt) :: &
+ integer :: &
    instance, sourceOffset
 
  instance = source_damage_isoBrittle_instance(phase)
@@ -248,25 +244,25 @@ function source_damage_isoBrittle_postResults(phase, constituent)
  use material, only: &
    sourceState
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    phase, &
    constituent
  real(pReal), dimension(sum(source_damage_isoBrittle_sizePostResult(:, &
                          source_damage_isoBrittle_instance(phase)))) :: &
    source_damage_isoBrittle_postResults
 
- integer(pInt) :: &
+ integer :: &
    instance, sourceOffset, o, c
    
  instance = source_damage_isoBrittle_instance(phase)
  sourceOffset = source_damage_isoBrittle_offset(phase)
 
- c = 0_pInt
+ c = 0
 
- do o = 1_pInt,size(param(instance)%outputID)
+ do o = 1,size(param(instance)%outputID)
     select case(param(instance)%outputID(o))
       case (damage_drivingforce_ID)
-        source_damage_isoBrittle_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
+        source_damage_isoBrittle_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
         c = c + 1
 
     end select

src/source_damage_isoDuctile.f90

@@ -5,20 +5,18 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module source_damage_isoDuctile
- use prec, only: &
+ use prec
-   pReal, &
-   pInt
 
  implicit none
  private
- integer(pInt),                       dimension(:),           allocatable,         public, protected :: &
+ integer,                       dimension(:),           allocatable,         public, protected :: &
    source_damage_isoDuctile_offset, &                                                                 !< which source is my current damage mechanism?
    source_damage_isoDuctile_instance                                                                  !< instance of damage source mechanism
 
- integer(pInt),                       dimension(:,:),         allocatable, target, public :: &
+ integer,                       dimension(:,:),         allocatable, target, public :: &
    source_damage_isoDuctile_sizePostResult                                                            !< size of each post result output
 
- character(len=64),                   dimension(:,:),         allocatable, target, public :: &
+ character(len=64),             dimension(:,:),         allocatable, target, public :: &
    source_damage_isoDuctile_output                                                                    !< name of each post result output
 
 
@@ -53,8 +51,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine source_damage_isoDuctile_init
- use prec, only: &
-   pStringLen
  use debug, only: &
    debug_level,&
    debug_constitutive,&
@@ -75,8 +71,8 @@ subroutine source_damage_isoDuctile_init
    material_Nphase
 
 
- integer(pInt) :: Ninstance,phase,instance,source,sourceOffset
+ integer :: Ninstance,phase,instance,source,sourceOffset
- integer(pInt) :: NofMyPhase,p,i
+ integer :: NofMyPhase,p,i
  character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
  integer(kind(undefined_ID)) :: &
    outputID
@@ -89,13 +85,13 @@ subroutine source_damage_isoDuctile_init
  write(6,'(/,a)')   ' <<<+-  source_'//SOURCE_DAMAGE_ISODUCTILE_LABEL//' init  -+>>>'
 
  Ninstance = count(phase_source == SOURCE_damage_isoDuctile_ID)
- if (Ninstance == 0_pInt) return
+ if (Ninstance == 0) return
  
  if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0) &
    write(6,'(a16,1x,i5,/)') '# instances:',Ninstance
  
- allocate(source_damage_isoDuctile_offset(material_Nphase), source=0_pInt)
+ allocate(source_damage_isoDuctile_offset(material_Nphase), source=0)
- allocate(source_damage_isoDuctile_instance(material_Nphase), source=0_pInt)
+ allocate(source_damage_isoDuctile_instance(material_Nphase), source=0)
  do phase = 1, material_Nphase
    source_damage_isoDuctile_instance(phase) = count(phase_source(:,1:phase) == source_damage_isoDuctile_ID)
    do source = 1, phase_Nsources(phase)
@@ -104,7 +100,7 @@ subroutine source_damage_isoDuctile_init
    enddo    
  enddo
    
- allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0_pInt)
+ allocate(source_damage_isoDuctile_sizePostResult(maxval(phase_Noutput),Ninstance),source=0)
  allocate(source_damage_isoDuctile_output(maxval(phase_Noutput),Ninstance))
           source_damage_isoDuctile_output = ''
 
@@ -129,18 +125,18 @@ subroutine source_damage_isoDuctile_init
 !--------------------------------------------------------------------------------------------------
 !  exit if any parameter is out of range
    if (extmsg /= '') &
-     call IO_error(211_pInt,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')')
+     call IO_error(211,ext_msg=trim(extmsg)//'('//SOURCE_DAMAGE_ISODUCTILE_LABEL//')')
 
 !--------------------------------------------------------------------------------------------------
 !  output pararameters
    outputs = config%getStrings('(output)',defaultVal=emptyStringArray)
    allocate(prm%outputID(0))
-   do i=1_pInt, size(outputs)
+   do i=1, size(outputs)
      outputID = undefined_ID
      select case(outputs(i))
      
        case ('isoductile_drivingforce')
-         source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1_pInt
+         source_damage_isoDuctile_sizePostResult(i,source_damage_isoDuctile_instance(p)) = 1
          source_damage_isoDuctile_output(i,source_damage_isoDuctile_instance(p)) = outputs(i)
          prm%outputID = [prm%outputID, damage_drivingforce_ID]
 
@@ -155,7 +151,7 @@ subroutine source_damage_isoDuctile_init
    instance = source_damage_isoDuctile_instance(phase)
    sourceOffset = source_damage_isoDuctile_offset(phase)
 
-   call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1_pInt,1_pInt,0_pInt)
+   call material_allocateSourceState(phase,sourceOffset,NofMyPhase,1,1,0)
    sourceState(phase)%p(sourceOffset)%sizePostResults = sum(source_damage_isoDuctile_sizePostResult(:,instance))
    sourceState(phase)%p(sourceOffset)%aTolState=param(instance)%aTol
               
@@ -176,11 +172,11 @@ subroutine source_damage_isoDuctile_dotState(ipc, ip, el)
    damage, &
    damageMapping
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    ipc, &                                                                                           !< component-ID of integration point
    ip, &                                                                                            !< integration point
    el                                                                                               !< element
- integer(pInt) :: &
+ integer :: &
    phase, constituent, instance, homog, sourceOffset, damageOffset
 
  phase = phaseAt(ipc,ip,el)
@@ -204,7 +200,7 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD
  use material, only: &
    sourceState
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    phase, &
    constituent
  real(pReal),  intent(in) :: &
@@ -212,7 +208,7 @@ subroutine source_damage_isoDuctile_getRateAndItsTangent(localphiDot, dLocalphiD
  real(pReal),  intent(out) :: &
    localphiDot, &
    dLocalphiDot_dPhi
- integer(pInt) :: &
+ integer :: &
    sourceOffset
 
  sourceOffset = source_damage_isoDuctile_offset(phase)
@@ -231,25 +227,25 @@ function source_damage_isoDuctile_postResults(phase, constituent)
  use material, only: &
    sourceState
 
- integer(pInt), intent(in) :: &
+ integer, intent(in) :: &
    phase, &
    constituent
  real(pReal), dimension(sum(source_damage_isoDuctile_sizePostResult(:, &
                           source_damage_isoDuctile_instance(phase)))) :: &
    source_damage_isoDuctile_postResults
 
- integer(pInt) :: &
+ integer :: &
    instance, sourceOffset, o, c
    
  instance = source_damage_isoDuctile_instance(phase)
  sourceOffset = source_damage_isoDuctile_offset(phase)
 
- c = 0_pInt
+ c = 0
 
- do o = 1_pInt,size(param(instance)%outputID)
+ do o = 1,size(param(instance)%outputID)
     select case(param(instance)%outputID(o))
       case (damage_drivingforce_ID)
-        source_damage_isoDuctile_postResults(c+1_pInt) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
+        source_damage_isoDuctile_postResults(c+1) = sourceState(phase)%p(sourceOffset)%state(1,constituent)
         c = c + 1
 
     end select

src/source_thermal_dissipation.f90

@@ -5,27 +5,30 @@
 !> @details to be done
 !--------------------------------------------------------------------------------------------------
 module source_thermal_dissipation
-  use prec, only: &
+  use prec
-    pReal
+  use debug
+  use material
+  use config
  
   implicit none
   private
+
   integer,           dimension(:),   allocatable,         public, protected :: &
-    source_thermal_dissipation_offset, &                                                                 !< which source is my current thermal dissipation mechanism?
+    source_thermal_dissipation_offset, &                                                            !< which source is my current thermal dissipation mechanism?
-    source_thermal_dissipation_instance                                                                  !< instance of thermal dissipation source mechanism
+    source_thermal_dissipation_instance                                                             !< instance of thermal dissipation source mechanism
  
   integer,           dimension(:,:), allocatable, target, public :: &
-    source_thermal_dissipation_sizePostResult                                                            !< size of each post result output
+    source_thermal_dissipation_sizePostResult                                                       !< size of each post result output
  
   character(len=64), dimension(:,:), allocatable, target, public :: &
-    source_thermal_dissipation_output                                                                    !< name of each post result output
+    source_thermal_dissipation_output                                                               !< name of each post result output
  
-  type, private :: tParameters                                                                       !< container type for internal constitutive parameters
+  type :: tParameters                                                                               !< container type for internal constitutive parameters
     real(pReal) :: &
       kappa
   end type tParameters
  
-  type(tParameters), dimension(:),   allocatable, private :: param                                     !< containers of constitutive parameters (len Ninstance)
+  type(tParameters), dimension(:),   allocatable :: param                                           !< containers of constitutive parameters (len Ninstance)
  
  
   public :: &
@@ -40,21 +43,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine source_thermal_dissipation_init
-  use debug, only: &
-    debug_level,&
-    debug_constitutive,&
-    debug_levelBasic
-  use material, only: &
-    material_allocateSourceState, &
-    phase_source, &
-    phase_Nsources, &
-    phase_Noutput, &
-    SOURCE_thermal_dissipation_label, &
-    SOURCE_thermal_dissipation_ID, &
-    material_phase
-  use config, only: &
-    config_phase, &
-    material_Nphase
  
   integer :: Ninstance,instance,source,sourceOffset
   integer :: NofMyPhase,p   

src/source_thermal_externalheat.f90

@@ -5,11 +5,14 @@
 !> @brief material subroutine for variable heat source
 !--------------------------------------------------------------------------------------------------
 module source_thermal_externalheat
-  use prec, only: &
+  use prec
-    pReal
+  use debug
+  use material
+  use config
 
   implicit none
   private
+
   integer,           dimension(:),   allocatable,         public, protected :: &
     source_thermal_externalheat_offset, &                                                                 !< which source is my current thermal dissipation mechanism?
     source_thermal_externalheat_instance                                                                  !< instance of thermal dissipation source mechanism
@@ -23,7 +26,7 @@ module source_thermal_externalheat
   integer,                       dimension(:),   allocatable, target, public :: &
     source_thermal_externalheat_Noutput                                                                   !< number of outputs per instance of this source 
 
-  type, private :: tParameters                                                                       !< container type for internal constitutive parameters
+  type  :: tParameters                                                                              !< container type for internal constitutive parameters
     real(pReal), dimension(:), allocatable :: &
       time, &
       heat_rate
@@ -31,7 +34,7 @@ module source_thermal_externalheat
      nIntervals
   end type tParameters
 
-  type(tParameters), dimension(:), allocatable, private :: param                                     !< containers of constitutive parameters (len Ninstance)
+  type(tParameters), dimension(:), allocatable  :: param                                            !< containers of constitutive parameters (len Ninstance)
 
 
   public :: &
@@ -47,22 +50,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine source_thermal_externalheat_init
-  use debug, only: &
-    debug_level,&
-    debug_constitutive,&
-    debug_levelBasic
-  use material, only: &
-    material_allocateSourceState, &
-    material_phase, &
-    phase_source, &
-    phase_Nsources, &
-    phase_Noutput, &
-    SOURCE_thermal_externalheat_label, &
-    SOURCE_thermal_externalheat_ID
-  use config, only: &
-    config_phase, &
-    material_Nphase
- 
  
   integer :: maxNinstance,instance,source,sourceOffset,NofMyPhase,p   
  
@@ -116,8 +103,6 @@ end subroutine source_thermal_externalheat_init
 !> @details state only contains current time to linearly interpolate given heat powers
 !--------------------------------------------------------------------------------------------------
 subroutine source_thermal_externalheat_dotState(phase, of)
-  use material, only: &
-    sourceState
  
   integer, intent(in) :: &
     phase, &
@@ -135,8 +120,6 @@ end subroutine source_thermal_externalheat_dotState
 !> @brief returns local heat generation rate 
 !--------------------------------------------------------------------------------------------------
 subroutine source_thermal_externalheat_getRateAndItsTangent(TDot, dTDot_dT, phase, of)
-  use material, only: &
-    sourceState
  
   integer, intent(in) :: &
     phase, &

src/thermal_adiabatic.f90

@@ -3,9 +3,16 @@
 !> @brief material subroutine for adiabatic temperature evolution
 !--------------------------------------------------------------------------------------------------
 module thermal_adiabatic
-  use prec, only: &
+  use prec
-    pReal
+  use config
- 
+  use numerics
+  use material
+  use source_thermal_dissipation
+  use source_thermal_externalheat
+  use crystallite
+  use lattice
+  use mesh
+
   implicit none
   private
  
@@ -21,7 +28,7 @@ module thermal_adiabatic
     enumerator :: undefined_ID, &
                   temperature_ID
   end enum
-  integer(kind(undefined_ID)),   dimension(:,:),  allocatable,          private :: & 
+  integer(kind(undefined_ID)),   dimension(:,:),  allocatable :: & 
     thermal_adiabatic_outputID                                                                      !< ID of each post result output
  
  
@@ -41,21 +48,6 @@ contains
 !> @details reads in material parameters, allocates arrays, and does sanity checks
 !--------------------------------------------------------------------------------------------------
 subroutine thermal_adiabatic_init
-  use material, only: &
-    thermal_type, &
-    thermal_typeInstance, &
-    homogenization_Noutput, &
-    THERMAL_ADIABATIC_label, &
-    THERMAL_adiabatic_ID, &
-    material_homogenizationAt, & 
-    mappingHomogenization, & 
-    thermalState, &
-    thermalMapping, &
-    thermal_initialT, &
-    temperature, &
-    temperatureRate
-  use config, only: &
-    config_homogenization
  
   integer :: maxNinstance,section,instance,i,sizeState,NofMyHomog   
   character(len=65536),   dimension(0), parameter :: emptyStringArray = [character(len=65536)::]
@@ -112,16 +104,6 @@ end subroutine thermal_adiabatic_init
 !> @brief  calculates adiabatic change in temperature based on local heat generation model  
 !--------------------------------------------------------------------------------------------------
 function thermal_adiabatic_updateState(subdt, ip, el)
-  use numerics, only: &
-    err_thermal_tolAbs, &
-    err_thermal_tolRel
-  use material, only: &
-    material_homogenizationAt, &
-    mappingHomogenization, &
-    thermalState, &
-    temperature, &
-    temperatureRate, &
-    thermalMapping
   
   integer,     intent(in) :: &
     ip, &                                                                                           !< integration point number
@@ -156,28 +138,11 @@ function thermal_adiabatic_updateState(subdt, ip, el)
   
 end function thermal_adiabatic_updateState
 
+
 !--------------------------------------------------------------------------------------------------
 !> @brief returns heat generation rate
 !--------------------------------------------------------------------------------------------------
 subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
-  use material, only: &
-    homogenization_Ngrains, &
-    material_homogenizationAt, &
-    mappingHomogenization, &
-    phaseAt, &
-    phasememberAt, &
-    thermal_typeInstance, &
-    phase_Nsources, &
-    phase_source, &
-    SOURCE_thermal_dissipation_ID, &
-    SOURCE_thermal_externalheat_ID
-  use source_thermal_dissipation, only: &
-    source_thermal_dissipation_getRateAndItsTangent
-  use source_thermal_externalheat, only: &
-    source_thermal_externalheat_getRateAndItsTangent
-  use crystallite, only: &
-    crystallite_S, &
-    crystallite_Lp  
  
   integer,     intent(in) :: &
     ip, &                                                                                           !< integration point number
@@ -230,18 +195,12 @@ subroutine thermal_adiabatic_getSourceAndItsTangent(Tdot, dTdot_dT, T, ip, el)
   dTdot_dT = dTdot_dT/real(homogenization_Ngrains(homog),pReal)
  
 end subroutine thermal_adiabatic_getSourceAndItsTangent
- 
+
+
 !--------------------------------------------------------------------------------------------------
 !> @brief returns homogenized specific heat capacity
 !--------------------------------------------------------------------------------------------------
 function thermal_adiabatic_getSpecificHeat(ip,el)
-  use lattice, only: &
-    lattice_specificHeat
-  use material, only: &
-    homogenization_Ngrains, &
-    material_phase
-  use mesh, only: &
-    mesh_element
  
   integer, intent(in) :: &
     ip, &                                                                                           !< integration point number
@@ -270,13 +229,6 @@ end function thermal_adiabatic_getSpecificHeat
 !> @brief returns homogenized mass density
 !--------------------------------------------------------------------------------------------------
 function thermal_adiabatic_getMassDensity(ip,el)
-  use lattice, only: &
-    lattice_massDensity
-  use material, only: &
-    homogenization_Ngrains, &
-    material_phase
-  use mesh, only: &
-    mesh_element
     
   integer, intent(in) :: &
     ip, &                                                                                           !< integration point number
@@ -304,8 +256,6 @@ end function thermal_adiabatic_getMassDensity
 !> @brief return array of thermal results
 !--------------------------------------------------------------------------------------------------
 function thermal_adiabatic_postResults(homog,instance,of) result(postResults)
-  use material, only: &
-    temperature
  
   integer, intent(in) :: &
     homog, &