diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f1af6259f..25616cc99 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -7,9 +7,9 @@ stages: - compilePETScGNU - prepareSpectral - spectral - - compileMarc2018_1 + - compileMarc - marc - - compileAbaqus2017 + - compileAbaqus - example - performance - createPackage @@ -51,39 +51,37 @@ variables: # Names of module files to load # =============================================================================================== # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ - IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016" - IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4" - IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017" - IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018" - GNUCompiler7_3: "Compiler/GNU/7.3" + IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016" + IntelCompiler17_8: "Compiler/Intel/17.8 Libraries/IMKL/2017" + IntelCompiler18_4: "Compiler/Intel/18.4 Libraries/IMKL/2018" + GNUCompiler8_2: "Compiler/GNU/8.2" # ------------ Defaults ---------------------------------------------- - IntelCompiler: "$IntelCompiler18_1" - GNUCompiler: "$GNUCompiler7_3" + IntelCompiler: "$IntelCompiler18_4" + GNUCompiler: "$GNUCompiler8_2" # ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++ - MPICH3_2Intel18_1: "MPI/Intel/18.1/MPICH/3.2.1" - MPICH3_2GNU7_3: "MPI/GNU/7.3/MPICH/3.2.1" + IMPI2018Intel18_4: "MPI/Intel/18.4/IntelMPI/2018" + MPICH3_3GNU8_2: "MPI/GNU/8.2/MPICH/3.3" # ------------ Defaults ---------------------------------------------- - MPICH_Intel: "$MPICH3_2Intel18_1" - MPICH_GNU: "$MPICH3_2GNU7_3" + MPICH_Intel: "$IMPI2018Intel18_4" + MPICH_GNU: "$MPICH3_3GNU8_2" # ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++ - PETSc3_10_0MPICH3_2Intel18_1: "Libraries/PETSc/3.10.0/Intel-18.1-MPICH-3.2.1" - PETSc3_10_0MPICH3_2GNU7_3: "Libraries/PETSc/3.10.0/GNU-7.3-MPICH-3.2.1" + PETSc3_10_3IMPI2018Intel18_4: "Libraries/PETSc/3.10.3/Intel-18.4-IntelMPI-2018" + PETSc3_10_3MPICH3_3GNU8_2: "Libraries/PETSc/3.10.3/GNU-8.2-MPICH-3.3" # ------------ Defaults ---------------------------------------------- - PETSc_MPICH_Intel: "$PETSc3_10_0MPICH3_2Intel18_1" - PETSc_MPICH_GNU: "$PETSc3_10_0MPICH3_2GNU7_3" + PETSc_MPICH_Intel: "$PETSc3_10_3IMPI2018Intel18_4" + PETSc_MPICH_GNU: "$PETSc3_10_3MPICH3_3GNU8_2" # ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++ - Abaqus2017: "FEM/Abaqus/2017" + Abaqus2019: "FEM/Abaqus/2019" MSC2018_1: "FEM/MSC/2018.1" - MSC2017: "FEM/MSC/2017" # ------------ Defaults ---------------------------------------------- - Abaqus: "$Abaqus2017" + Abaqus: "$Abaqus2019" MSC: "$MSC2018_1" - IntelMarc: "$IntelCompiler17_0" + IntelMarc: "$IntelCompiler17_8" IntelAbaqus: "$IntelCompiler16_4" # ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++ - Doxygen1_8_13: "Documentation/Doxygen/1.8.13" + Doxygen1_8_15: "Documentation/Doxygen/1.8.15" # ------------ Defaults ---------------------------------------------- - Doxygen: "$Doxygen1_8_13" + Doxygen: "$Doxygen1_8_15" ################################################################################################### @@ -158,6 +156,13 @@ Post_AverageDown: - master - release +Post_ASCIItable: + stage: postprocessing + script: ASCIItable/test.py + except: + - master + - release + Post_General: stage: postprocessing script: PostProcessing/test.py @@ -383,9 +388,9 @@ TextureComponents: ################################################################################################### Marc_compileIfort2018_1: - stage: compileMarc2018_1 + stage: compileMarc script: - - module load $IntelCompiler17_0 $MSC2018_1 + - module load $IntelMarc $MSC - Marc_compileIfort/test.py -m 2018.1 except: - master @@ -430,11 +435,11 @@ J2_plasticBehavior: - release ################################################################################################### -Abaqus_compile2017: - stage: compileAbaqus2017 +Abaqus_compile: + stage: compileAbaqus script: - - module load $IntelCompiler16_4 $Abaqus2017 - - Abaqus_compileIfort/test.py -a 2017 + - module load $IntelAbaqus $Abaqus + - Abaqus_compileIfort/test.py except: - master - release diff --git a/CONFIG b/CONFIG index 13b75a768..31a9c34c8 100644 --- a/CONFIG +++ b/CONFIG @@ -8,6 +8,6 @@ set DAMASK_NUM_THREADS = 4 set MSC_ROOT = /opt/msc set MARC_VERSION = 2018.1 -set ABAQUS_VERSION = 2017 +set ABAQUS_VERSION = 2019 set DAMASK_HDF5 = OFF diff --git a/PRIVATE b/PRIVATE index beb9682ff..18ba1ba6a 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b +Subproject commit 18ba1ba6a5e9ba446dc9311acf2acf2781614db1 diff --git a/README b/README index 5c5d976b6..7fc372881 100644 --- a/README +++ b/README @@ -10,3 +10,4 @@ Germany Email: DAMASK@mpie.de https://damask.mpie.de +https://magit1.mpie.de diff --git a/VERSION b/VERSION index 6e1ce244f..e1be2bda8 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1689-g1a471bcd +v2.0.2-1789-g524bfb8c diff --git a/processing/post/addCumulative.py b/processing/post/addCumulative.py index 4588d915c..dfa8059dc 100755 --- a/processing/post/addCumulative.py +++ b/processing/post/addCumulative.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/post/addDerivative.py b/processing/post/addDerivative.py index dc97c09ea..35ca7130b 100755 --- a/processing/post/addDerivative.py +++ b/processing/post/addDerivative.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/post/addLinked.py b/processing/post/addLinked.py index d60307bc2..097f8f2c5 100755 --- a/processing/post/addLinked.py +++ b/processing/post/addLinked.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys @@ -21,7 +21,7 @@ Add data of selected column(s) from (first) row of linked ASCIItable that shares parser.add_option('--link', dest = 'link', nargs = 2, type = 'string', metavar = 'string string', - help = 'column labels containing linked values') + help = 'column labels of table and linked table containing linking values') parser.add_option('-l','--label', dest = 'label', action = 'extend', metavar = '', @@ -105,7 +105,8 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table try: - table.data_append(data[np.argwhere(np.all((map(float,table.data[myLink:myLink+myLinkDim]) - index)==0,axis=1))[0]]) # add data of first matching line + table.data_append(data[np.argwhere(np.all((list(map(float,table.data[myLink:myLink+myLinkDim])) - index)==0, + axis=1))[0]]) # add data of first matching line except IndexError: table.data_append(np.nan*np.ones_like(data[0])) # or add NaNs outputAlive = table.data_write() # output processed line diff --git a/processing/post/addTable.py b/processing/post/addTable.py index 82799b4f5..126db6f65 100755 --- a/processing/post/addTable.py +++ b/processing/post/addTable.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index 5a0d631e0..22de70d5b 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py index e0c274dc7..315071a4b 100755 --- a/processing/post/vtk_addGridData.py +++ b/processing/post/vtk_addGridData.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,vtk diff --git a/processing/post/vtk_addPointcloudData.py b/processing/post/vtk_addPointcloudData.py index 3937413c6..d75eb97b4 100755 --- a/processing/post/vtk_addPointcloudData.py +++ b/processing/post/vtk_addPointcloudData.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,vtk diff --git a/processing/post/vtk_addRectilinearGridData.py b/processing/post/vtk_addRectilinearGridData.py index 9ec384e4d..83a1451a0 100755 --- a/processing/post/vtk_addRectilinearGridData.py +++ b/processing/post/vtk_addRectilinearGridData.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,vtk diff --git a/processing/post/vtk_pointcloud.py b/processing/post/vtk_pointcloud.py index 54f02d300..a9ce1f81f 100755 --- a/processing/post/vtk_pointcloud.py +++ b/processing/post/vtk_pointcloud.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys,vtk diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index d01d118cb..c94f44228 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys,vtk diff --git a/processing/pre/geom_grainGrowth.py b/processing/pre/geom_grainGrowth.py index f1394cb5f..1afb02715 100755 --- a/processing/pre/geom_grainGrowth.py +++ b/processing/pre/geom_grainGrowth.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys,math @@ -49,7 +49,7 @@ parser.set_defaults(d = 1, (options, filenames) = parser.parse_args() -options.immutable = map(int,options.immutable) +options.immutable = list(map(int,options.immutable)) getInterfaceEnergy = lambda A,B: np.float32((A*B != 0)*(A != B)*1.0) # 1.0 if A & B are distinct & nonzero, 0.0 otherwise struc = ndimage.generate_binary_structure(3,1) # 3D von Neumann neighborhood @@ -70,9 +70,9 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - 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']))), + 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']), ]) @@ -102,9 +102,9 @@ for name in filenames: gauss = np.exp(-(X*X + Y*Y + Z*Z)/(2.0*options.d*options.d),dtype=np.float32) \ /np.power(2.0*np.pi*options.d*options.d,(3.0 - np.count_nonzero(info['grid'] == 1))/2.,dtype=np.float32) - gauss[:,:,:grid[2]/2:-1] = gauss[:,:,1:(grid[2]+1)/2] # trying to cope with uneven (odd) grid size - gauss[:,:grid[1]/2:-1,:] = gauss[:,1:(grid[1]+1)/2,:] - gauss[:grid[0]/2:-1,:,:] = gauss[1:(grid[0]+1)/2,:,:] + gauss[:,:,:grid[2]//2:-1] = gauss[:,:,1:(grid[2]+1)//2] # trying to cope with uneven (odd) grid size + gauss[:,:grid[1]//2:-1,:] = gauss[:,1:(grid[1]+1)//2,:] + gauss[:grid[0]//2:-1,:,:] = gauss[1:(grid[0]+1)//2,:,:] gauss = np.fft.rfftn(gauss).astype(np.complex64) for smoothIter in range(options.N): @@ -119,9 +119,9 @@ for name in filenames: microstructure,i,axis=0), j,axis=1), k,axis=2))) # periodically extend interfacial energy array by half a grid size in positive and negative directions - periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] + periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # transform bulk volume (i.e. where interfacial energy remained zero), store index of closest boundary voxel index = ndimage.morphology.distance_transform_edt(periodic_interfaceEnergy == 0., @@ -148,15 +148,15 @@ for name in filenames: ndimage.morphology.binary_dilation(interfaceEnergy > 0., structure = struc, iterations = int(round(options.d*2.))-1),# fat boundary - periodic_bulkEnergy[grid[0]/2:-grid[0]/2, # retain filled energy on fat boundary... - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2], # ...and zero everywhere else + periodic_bulkEnergy[grid[0]//2:-grid[0]//2, # retain filled energy on fat boundary... + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2], # ...and zero everywhere else 0.)).astype(np.complex64) * gauss).astype(np.float32) - periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] # periodically extend the smoothed bulk energy + periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # periodically extend the smoothed bulk energy # transform voxels close to interface region @@ -164,15 +164,15 @@ for name in filenames: return_distances = False, return_indices = True) # want index of closest bulk grain - periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] # periodically extend the microstructure + periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # periodically extend the microstructure microstructure = periodic_microstructure[index[0], index[1], - index[2]].reshape(2*grid)[grid[0]/2:-grid[0]/2, - grid[1]/2:-grid[1]/2, - grid[2]/2:-grid[2]/2] # extent grains into interface region + index[2]].reshape(2*grid)[grid[0]//2:-grid[0]//2, + grid[1]//2:-grid[1]//2, + grid[2]//2:-grid[2]//2] # extent grains into interface region # replace immutable microstructures with closest mutable ones index = ndimage.morphology.distance_transform_edt(np.in1d(microstructure,options.immutable).reshape(grid), @@ -236,3 +236,4 @@ for name in filenames: # --- output finalization -------------------------------------------------------------------------- table.close() + \ No newline at end of file diff --git a/processing/pre/geom_toTable.py b/processing/pre/geom_toTable.py index eb6bdde61..a29ef7afb 100755 --- a/processing/pre/geom_toTable.py +++ b/processing/pre/geom_toTable.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import os,sys @@ -48,11 +48,11 @@ for name in filenames: table.head_read() info,extra_header = table.head_getGeom() - 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'], + 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 = [] diff --git a/processing/pre/seeds_fromDistribution.py b/processing/pre/seeds_fromDistribution.py index 3b9005032..2e8936f27 100755 --- a/processing/pre/seeds_fromDistribution.py +++ b/processing/pre/seeds_fromDistribution.py @@ -1,10 +1,11 @@ -#!/usr/bin/env python2.7 +#!/usr/bin/env python3 # -*- coding: UTF-8 no BOM -*- import threading,time,os,sys,random import numpy as np from optparse import OptionParser -from cStringIO import StringIO +from io import StringIO +import binascii import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] @@ -96,7 +97,7 @@ class myThread (threading.Thread): perturbedGeomVFile = StringIO() perturbedSeedsVFile.reset() perturbedGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+ - ' -g '+' '.join(map(str, options.grid)),streamIn=perturbedSeedsVFile)[0]) + ' -g '+' '.join(list(map(str, options.grid))),streamIn=perturbedSeedsVFile)[0]) perturbedGeomVFile.reset() #--- evaluate current seeds file ---------------------------------------------------------------------- @@ -214,7 +215,7 @@ options = parser.parse_args()[0] damask.util.report(scriptName,options.seedFile) if options.randomSeed is None: - options.randomSeed = int(os.urandom(4).encode('hex'), 16) + options.randomSeed = int(binascii.hexlify(os.urandom(4)),16) damask.util.croak(options.randomSeed) delta = (options.scale/options.grid[0],options.scale/options.grid[1],options.scale/options.grid[2]) baseFile=os.path.splitext(os.path.basename(options.seedFile))[0] @@ -240,17 +241,17 @@ if os.path.isfile(os.path.splitext(options.seedFile)[0]+'.seeds'): for line in initialSeedFile: bestSeedsVFile.write(line) else: bestSeedsVFile.write(damask.util.execute('seeds_fromRandom'+\ - ' -g '+' '.join(map(str, options.grid))+\ + ' -g '+' '.join(list(map(str, options.grid)))+\ ' -r {:d}'.format(options.randomSeed)+\ ' -N '+str(nMicrostructures))[0]) bestSeedsUpdate = time.time() # ----------- tessellate initial seed file to get and evaluate geom file -bestSeedsVFile.reset() +bestSeedsVFile.seek(0) initialGeomVFile = StringIO() initialGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+ - ' -g '+' '.join(map(str, options.grid)),bestSeedsVFile)[0]) -initialGeomVFile.reset() + ' -g '+' '.join(list(map(str, options.grid))),bestSeedsVFile)[0]) +initialGeomVFile.seek(0) initialGeomTable = damask.ASCIItable(initialGeomVFile,None,labeled=False,readonly=True) initialGeomTable.head_read() info,devNull = initialGeomTable.head_getGeom() diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index bf8691533..22dbab045 100644 --- a/python/damask/solver/abaqus.py +++ b/python/damask/solver/abaqus.py @@ -2,7 +2,7 @@ from .solver import Solver import damask -import subprocess,re +import subprocess class Abaqus(Solver): @@ -15,14 +15,13 @@ class Abaqus(Solver): def return_run_command(self,model): env=damask.Environment() - shortVersion = re.sub('[\.,-]', '',self.version) try: - cmd='abq'+shortVersion - subprocess.check_output(['abq'+shortVersion,'information=release']) + cmd='abq'+self.version + subprocess.check_output([cmd,'information=release']) except OSError: # link to abqXXX not existing cmd='abaqus' process = subprocess.Popen(['abaqus','information=release'],stdout = subprocess.PIPE,stderr = subprocess.PIPE) - detectedVersion = process.stdout.readlines()[1].split()[1] + detectedVersion = process.stdout.readlines()[1].split()[1].decode('utf-8') if self.version != detectedVersion: - raise Exception('found Abaqus version %s, but requested %s'%(detectedVersion,self.version)) - return '%s -job %s -user %s/src/DAMASK_abaqus interactive'%(cmd,model,env.rootDir()) + raise Exception('found Abaqus version {}, but requested {}'.format(detectedVersion,self.version)) + return '{} -job {} -user {}/src/DAMASK_abaqus interactive'.format(cmd,model,env.rootDir()) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 23c7a5643..8d0697a65 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -7,6 +7,7 @@ endif() # The dependency detection in CMake is not functioning for Fortran, # hence we declare the dependencies from top to bottom in the following + add_library(C_ROUTINES OBJECT "C_routines.c") set(OBJECTFILES $) @@ -17,6 +18,10 @@ list(APPEND OBJECTFILES $) add_library(PREC OBJECT "prec.f90") list(APPEND OBJECTFILES $) +add_library(ELEMENT OBJECT "element.f90") +add_dependencies(ELEMENT PREC) +list(APPEND OBJECTFILES $) + add_library(QUIT OBJECT "quit.f90") add_dependencies(QUIT PREC) list(APPEND OBJECTFILES $) @@ -34,7 +39,7 @@ add_dependencies(NUMERICS IO) list(APPEND OBJECTFILES $) add_library(DEBUG OBJECT "debug.f90") -add_dependencies(DEBUG NUMERICS) +add_dependencies(DEBUG IO) list(APPEND OBJECTFILES $) add_library(DAMASK_CONFIG OBJECT "config.f90") @@ -42,7 +47,7 @@ add_dependencies(DAMASK_CONFIG DEBUG) list(APPEND OBJECTFILES $) add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90") -add_dependencies(HDF5_UTILITIES DAMASK_CONFIG) +add_dependencies(HDF5_UTILITIES DAMASK_CONFIG NUMERICS) list(APPEND OBJECTFILES $) add_library(RESULTS OBJECT "results.f90") @@ -50,24 +55,28 @@ add_dependencies(RESULTS HDF5_UTILITIES) list(APPEND OBJECTFILES $) add_library(FEsolving OBJECT "FEsolving.f90") -add_dependencies(FEsolving RESULTS) +add_dependencies(FEsolving DEBUG) list(APPEND OBJECTFILES $) -add_library(DAMASK_MATH OBJECT "math.f90") -add_dependencies(DAMASK_MATH FEsolving) -list(APPEND OBJECTFILES $) +add_library(MATH OBJECT "math.f90") +add_dependencies(MATH NUMERICS) +list(APPEND OBJECTFILES $) + +add_library(MESH_BASE OBJECT "mesh_base.f90") +add_dependencies(MESH_BASE ELEMENT) +list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") - add_library(MESH OBJECT "mesh.f90") - add_dependencies(MESH DAMASK_MATH) + add_library(MESH OBJECT "mesh_grid.f90") + add_dependencies(MESH MESH_BASE MATH FEsolving) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") - add_dependencies(FEZoo DAMASK_MATH) + add_dependencies(FEZoo IO) list(APPEND OBJECTFILES $) - add_library(MESH OBJECT "meshFEM.f90") - add_dependencies(MESH FEZoo) + add_library(MESH OBJECT "mesh_FEM.f90") + add_dependencies(MESH FEZoo MESH_BASE MATH FEsolving) list(APPEND OBJECTFILES $) endif() @@ -75,9 +84,9 @@ add_library(MATERIAL OBJECT "material.f90") add_dependencies(MATERIAL MESH DAMASK_CONFIG) list(APPEND OBJECTFILES $) -add_library(DAMASK_HELPERS OBJECT "lattice.f90") -add_dependencies(DAMASK_HELPERS MATERIAL) -list(APPEND OBJECTFILES $) +add_library(LATTICE OBJECT "lattice.f90") +add_dependencies(LATTICE MATERIAL) +list(APPEND OBJECTFILES $) # For each modular section add_library (PLASTIC OBJECT @@ -88,14 +97,14 @@ add_library (PLASTIC OBJECT "plastic_kinematichardening.f90" "plastic_nonlocal.f90" "plastic_none.f90") -add_dependencies(PLASTIC DAMASK_HELPERS) +add_dependencies(PLASTIC LATTICE RESULTS) list(APPEND OBJECTFILES $) add_library (KINEMATICS OBJECT "kinematics_cleavage_opening.f90" "kinematics_slipplane_opening.f90" "kinematics_thermal_expansion.f90") -add_dependencies(KINEMATICS DAMASK_HELPERS) +add_dependencies(KINEMATICS LATTICE RESULTS) list(APPEND OBJECTFILES $) add_library (SOURCE OBJECT @@ -105,7 +114,7 @@ add_library (SOURCE OBJECT "source_damage_isoDuctile.f90" "source_damage_anisoBrittle.f90" "source_damage_anisoDuctile.f90") -add_dependencies(SOURCE DAMASK_HELPERS) +add_dependencies(SOURCE LATTICE RESULTS) list(APPEND OBJECTFILES $) add_library(CONSTITUTIVE OBJECT "constitutive.f90") diff --git a/src/CPFEM.f90 b/src/CPFEM.f90 index b0f1641e6..ba18f7d52 100644 --- a/src/CPFEM.f90 +++ b/src/CPFEM.f90 @@ -140,8 +140,7 @@ subroutine CPFEM_init restartRead, & modelName use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & material_phase, & homogState, & @@ -168,10 +167,9 @@ subroutine CPFEM_init flush(6) endif mainProcess - ! initialize stress and jacobian to zero - allocate(CPFEM_cs(6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_cs = 0.0_pReal - allocate(CPFEM_dcsdE(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE = 0.0_pReal - allocate(CPFEM_dcsdE_knownGood(6,6,mesh_maxNips,mesh_NcpElems)) ; CPFEM_dcsdE_knownGood = 0.0_pReal + allocate(CPFEM_cs( 6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) + allocate(CPFEM_dcsdE( 6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) + allocate(CPFEM_dcsdE_knownGood(6,6,theMesh%elem%nIPs,theMesh%Nelems), source= 0.0_pReal) ! *** restore the last converged values of each essential variable from the binary file if (restartRead) then @@ -289,8 +287,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt math_6toSym33 use mesh, only: & mesh_FEasCP, & - mesh_NcpElems, & - mesh_maxNips, & + theMesh, & mesh_element use material, only: & microstructure_elemhomo, & @@ -401,7 +398,7 @@ subroutine CPFEM_general(mode, parallelExecution, ffn, ffn1, temperature_inp, dt enddo; enddo if (iand(debug_level(debug_CPFEM), debug_levelBasic) /= 0_pInt) then write(6,'(a)') '<< CPFEM >> aging states' - if (debug_e <= mesh_NcpElems .and. debug_i <= mesh_maxNips) then + if (debug_e <= theMesh%Nelems .and. debug_i <= theMesh%elem%nIPs) then write(6,'(a,1x,i8,1x,i2,1x,i4,/,(12x,6(e20.8,1x)),/)') & '<< CPFEM >> aged state of elFE ip grain',debug_e, debug_i, 1, & plasticState(phaseAt(1,debug_i,debug_e))%state(:,phasememberAt(1,debug_i,debug_e)) diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index 91cc08296..b2aa2f598 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -95,8 +95,6 @@ subroutine CPFEM_init use prec, only: & pInt, pReal, pLongInt use IO, only: & - IO_read_realFile,& - IO_read_intFile, & IO_timeStamp, & IO_error use numerics, only: & diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index 9072de95d..8cd3a4930 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -30,6 +30,11 @@ contains !> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init +#if __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use ifport, only: & CHDIR @@ -40,16 +45,25 @@ subroutine DAMASK_interface_init character(len=256) :: wd call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' + write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>' + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' + write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(a,/)') ' Version: '//DAMASKVERSION + +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md +#if __INTEL_COMPILER >= 1800 + write(6,*) 'Compiled with: ', compiler_version() + write(6,*) 'Compiler options: ', compiler_options() +#else + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE +#endif + + write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) call getoutdir(wd, lenOutDir) ierr = CHDIR(wd) diff --git a/src/DAMASK_interface.f90 b/src/DAMASK_interface.f90 index 7a8e77f62..630b5b921 100644 --- a/src/DAMASK_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -143,16 +143,27 @@ subroutine DAMASK_interface_init() call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' - write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize -#include "compilation_info.f90" + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' + write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(a,/)') ' Version: '//DAMASKVERSION + +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + write(6,*) 'Compiled with: ', compiler_version() + write(6,*) 'Compiler options: ', compiler_options() +#elif defined(__INTEL_COMPILER) + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE +#elif defined(__PGI) + write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version :', __PGIC__,& + '.', __PGIC_MINOR__ +#endif + + write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) call get_command(commandLine) chunkPos = IIO_stringPos(commandLine) @@ -219,9 +230,11 @@ subroutine DAMASK_interface_init() call get_environment_variable('USER',userName) ! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux - write(6,'(a,a)') ' Host name: ', trim(getHostName()) - write(6,'(a,a)') ' User name: ', trim(userName) - write(6,'(a,a)') ' Command line call: ', trim(commandLine) + write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize + write(6,'(a,a)') ' Host name: ', trim(getHostName()) + write(6,'(a,a)') ' User name: ', trim(userName) + + write(6,'(/a,a)') ' Command line call: ', trim(commandLine) if (len(trim(workingDirArg)) > 0) & write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) @@ -514,4 +527,4 @@ pure function IIO_stringPos(string) end function IIO_stringPos -end module \ No newline at end of file +end module diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0c7d1adeb..892b2cbc4 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -43,6 +43,11 @@ contains !> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init +#if __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif use ifport, only: & CHDIR @@ -53,17 +58,26 @@ subroutine DAMASK_interface_init character(len=1024) :: wd call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' - write(6,'(/,a)') ' Version: '//DAMASKVERSION - write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& - dateAndTime(2),'/',& - dateAndTime(1) - write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& - dateAndTime(6),':',& - dateAndTime(7) - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' -#include "compilation_info.f90" + write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>' + write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478' + write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030' + + write(6,'(a,/)') ' Version: '//DAMASKVERSION + +! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md +#if __INTEL_COMPILER >= 1800 + write(6,*) 'Compiled with: ', compiler_version() + write(6,*) 'Compiler options: ', compiler_options() +#else + write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,& + ', build date :', __INTEL_COMPILER_BUILD_DATE +#endif + + write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ + + write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7) + inquire(5, name=wd) ! determine inputputfile wd = wd(1:scan(wd,'/',back=.true.)) ierr = CHDIR(wd) @@ -134,6 +148,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & debug_info, & debug_reset use mesh, only: & + theMesh, & mesh_FEasCP, & mesh_element, & mesh_node0, & @@ -141,8 +156,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & mesh_Ncellnodes, & mesh_cellnode, & mesh_build_cellnodes, & - mesh_build_ipCoordinates, & - FE_Nnodes + mesh_build_ipCoordinates use CPFEM, only: & CPFEM_general, & CPFEM_init_done, & @@ -314,7 +328,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & computationMode = ior(computationMode,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence lastIncConverged = .false. ! reset flag endif - do node = 1,FE_Nnodes(mesh_element(2,cp_en)) + do node = 1,theMesh%elem%nNodes CPnodeID = mesh_element(4_pInt+node,cp_en) mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node) enddo diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index fd6e90206..2087054bd 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -495,7 +495,6 @@ subroutine utilities_indexActiveSet(field,section,x_local,f_local,localIS,global CHKERRQ(ierr) call ISDestroy(dummyIS,ierr); CHKERRQ(ierr) endif - deallocate(localIndices) end subroutine utilities_indexActiveSet diff --git a/src/FEM_zoo.f90 b/src/FEM_zoo.f90 index 67c518c47..6abdfe883 100644 --- a/src/FEM_zoo.f90 +++ b/src/FEM_zoo.f90 @@ -9,11 +9,11 @@ module FEM_Zoo private integer(pInt), parameter, public:: & maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary) - real(pReal), dimension(2,3), private, protected :: & + real(pReal), dimension(2,3), private, parameter :: & triangle = reshape([-1.0_pReal, -1.0_pReal, & 1.0_pReal, -1.0_pReal, & -1.0_pReal, 1.0_pReal], shape=[2,3]) - real(pReal), dimension(3,4), private, protected :: & + real(pReal), dimension(3,4), private, parameter :: & tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, & 1.0_pReal, -1.0_pReal, -1.0_pReal, & -1.0_pReal, 1.0_pReal, -1.0_pReal, & diff --git a/src/IO.f90 b/src/IO.f90 index c8fe26735..3d330a2df 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -27,28 +27,17 @@ module IO IO_open_file_stat, & IO_open_jobFile_stat, & IO_open_file, & - IO_open_jobFile, & IO_write_jobFile, & IO_write_jobRealFile, & - IO_write_jobIntFile, & IO_read_realFile, & IO_read_intFile, & IO_isBlank, & IO_getTag, & IO_stringPos, & IO_stringValue, & - IO_fixedStringValue ,& IO_floatValue, & - IO_fixedNoEFloatValue, & IO_intValue, & - IO_fixedIntValue, & IO_lc, & - IO_skipChunks, & - IO_extractValue, & - IO_countDataLines, & - IO_countNumericalDataLines, & - IO_countContinuousIntValues, & - IO_continuousIntValues, & IO_error, & IO_warning, & IO_intOut, & @@ -56,39 +45,35 @@ module IO #if defined(Marc4DAMASK) || defined(Abaqus) public :: & IO_open_inputFile, & - IO_open_logFile + IO_open_logFile, & + IO_countContinuousIntValues, & + IO_continuousIntValues, & +#if defined(Abaqus) + IO_extractValue, & + IO_countDataLines +#elif defined(Marc4DAMASK) + IO_skipChunks, & + IO_fixedNoEFloatValue, & + IO_fixedIntValue, & + IO_countNumericalDataLines #endif -#ifdef Abaqus - public :: & - IO_abaqus_hasNoPart #endif private :: & - IO_fixedFloatValue, & IO_verifyFloatValue, & IO_verifyIntValue -#ifdef Abaqus - private :: & - abaqus_assembleInputFile -#endif contains !-------------------------------------------------------------------------------------------------- -!> @brief only outputs revision number +!> @brief does nothing. +! ToDo: needed? !-------------------------------------------------------------------------------------------------- subroutine IO_init -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif implicit none write(6,'(/,a)') ' <<<+- IO init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" end subroutine IO_init @@ -99,7 +84,7 @@ end subroutine IO_init !> @details unstable and buggy !-------------------------------------------------------------------------------------------------- recursive function IO_read(fileUnit,reset) result(line) - +!ToDo: remove recursion once material.config handling is done fully via config module implicit none integer(pInt), intent(in) :: fileUnit !< file unit logical, intent(in), optional :: reset @@ -167,6 +152,7 @@ recursive function IO_read(fileUnit,reset) result(line) end function IO_read + !-------------------------------------------------------------------------------------------------- !> @brief recursively reads a text file. !! Recursion is triggered by "{path/to/inputfile}" in a line @@ -290,7 +276,7 @@ end subroutine IO_open_file !> @details Like IO_open_file, but error is handled via return value and not via call to IO_error !-------------------------------------------------------------------------------------------------- logical function IO_open_file_stat(fileUnit,path) - +!ToDo: DEPRECATED once material.config handling is done fully via config module implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: path !< relative path from working directory @@ -304,30 +290,6 @@ logical function IO_open_file_stat(fileUnit,path) end function IO_open_file_stat -!-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. File is named after solver job name -!! plus given extension and located in current working directory -!> @details like IO_open_jobFile_stat, but error is handled via call to IO_error and not via return -!! value -!-------------------------------------------------------------------------------------------------- -subroutine IO_open_jobFile(fileUnit,ext) - use DAMASK_interface, only: & - getSolverJobName - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverJobName())//'.'//ext - open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - -end subroutine IO_open_jobFile - - !-------------------------------------------------------------------------------------------------- !> @brief opens existing file for reading to given unit. File is named after solver job name !! plus given extension and located in current working directory @@ -368,7 +330,7 @@ subroutine IO_open_inputFile(fileUnit,modelName) integer(pInt) :: myStat character(len=1024) :: path -#ifdef Abaqus +#if defined(Abaqus) integer(pInt) :: fileType fileType = 1_pInt ! assume .pes @@ -386,8 +348,60 @@ subroutine IO_open_inputFile(fileUnit,modelName) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s close(fileUnit+1_pInt) -#endif -#ifdef Marc4DAMASK + + contains + +!-------------------------------------------------------------------------------------------------- +!> @brief create a new input file for abaqus simulations by removing all comment lines and +!> including "include"s +!-------------------------------------------------------------------------------------------------- +recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) + + implicit none + integer(pInt), intent(in) :: unit1, & + unit2 + + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line,fname + logical :: createSuccess,fexist + + + do + read(unit2,'(A65536)',END=220) line + chunkPos = IO_stringPos(line) + + if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then + fname = trim(line(9+scan(line(9:),'='):)) + inquire(file=fname, exist=fexist) + if (.not.(fexist)) then + !$OMP CRITICAL (write2out) + write(6,*)'ERROR: file does not exist error in abaqus_assembleInputFile' + write(6,*)'filename: ', trim(fname) + !$OMP END CRITICAL (write2out) + createSuccess = .false. + return + endif + open(unit2+1,err=200,status='old',file=fname) + if (abaqus_assembleInputFile(unit1,unit2+1_pInt)) then + createSuccess=.true. + close(unit2+1) + else + createSuccess=.false. + return + endif + else if (line(1:2) /= '**' .OR. line(1:8)=='**damask') then + write(unit1,'(A)') trim(line) + endif + enddo + +220 createSuccess = .true. + return + +200 createSuccess =.false. + +end function abaqus_assembleInputFile +#elif defined(Marc4DAMASK) path = trim(modelName)//inputFileExtension open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -471,36 +485,6 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) end subroutine IO_write_jobRealFile -!-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is -!! named after solver job name plus given extension and located in current working directory -!-------------------------------------------------------------------------------------------------- -subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) - use DAMASK_interface, only: & - getSolverJobName - - implicit none - integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: ext !< extension of file - integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) - - integer(pInt) :: myStat - character(len=1024) :: path - - path = trim(getSolverJobName())//'.'//ext - if (present(recMultiplier)) then - open(fileUnit,status='replace',form='unformatted',access='direct', & - recl=pInt*recMultiplier,iostat=myStat,file=path) - else - open(fileUnit,status='replace',form='unformatted',access='direct', & - recl=pInt,iostat=myStat,file=path) - endif - - if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - -end subroutine IO_write_jobIntFile - - !-------------------------------------------------------------------------------------------------- !> @brief opens binary file containing array of pReal numbers to given unit for reading. File is !! located in current working directory @@ -557,35 +541,6 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) end subroutine IO_read_intFile -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief check if the input file for Abaqus contains part info -!-------------------------------------------------------------------------------------------------- -logical function IO_abaqus_hasNoPart(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line - - IO_abaqus_hasNoPart = .true. - -610 FORMAT(A65536) - rewind(fileUnit) - do - read(fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then - IO_abaqus_hasNoPart = .false. - exit - endif - enddo - -620 end function IO_abaqus_hasNoPart -#endif - - !-------------------------------------------------------------------------------------------------- !> @brief identifies strings without content !-------------------------------------------------------------------------------------------------- @@ -703,22 +658,6 @@ function IO_stringValue(string,chunkPos,myChunk,silent) end function IO_stringValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads string value at myChunk from fixed format string -!-------------------------------------------------------------------------------------------------- -pure function IO_fixedStringValue (string,ends,myChunk) - - implicit none - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=ends(myChunk+1)-ends(myChunk)) :: IO_fixedStringValue - character(len=*), intent(in) :: string !< raw input with known ends of each chunk - - IO_fixedStringValue = string(ends(myChunk)+1:ends(myChunk+1)) - -end function IO_fixedStringValue - - !-------------------------------------------------------------------------------------------------- !> @brief reads float value at myChunk from string !-------------------------------------------------------------------------------------------------- @@ -745,24 +684,30 @@ end function IO_floatValue !-------------------------------------------------------------------------------------------------- -!> @brief reads float value at myChunk from fixed format string +!> @brief reads integer value at myChunk from string !-------------------------------------------------------------------------------------------------- -real(pReal) function IO_fixedFloatValue (string,ends,myChunk) +integer(pInt) function IO_intValue(string,chunkPos,myChunk) implicit none - character(len=*), intent(in) :: string !< raw input with known ends of each chunk + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=20), parameter :: MYNAME = 'IO_fixedFloatValue: ' - character(len=17), parameter :: VALIDCHARACTERS = '0123456789eEdD.+-' + integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + character(len=13), parameter :: MYNAME = 'IO_intValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - IO_fixedFloatValue = & - IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& - VALIDCHARACTERS,MYNAME) + IO_intValue = 0_pInt -end function IO_fixedFloatValue + valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then + call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) + else valuePresent + IO_intValue = IO_verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& + VALIDCHARACTERS,MYNAME) + endif valuePresent + +end function IO_intValue +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string !-------------------------------------------------------------------------------------------------- @@ -796,30 +741,6 @@ real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) end function IO_fixedNoEFloatValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads integer value at myChunk from string -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_intValue(string,chunkPos,myChunk) - - implicit none - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - character(len=13), parameter :: MYNAME = 'IO_intValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - - IO_intValue = 0_pInt - - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then - call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) - else valuePresent - IO_intValue = IO_verifyIntValue(trim(adjustl(string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)))),& - VALIDCHARACTERS,MYNAME) - endif valuePresent - -end function IO_intValue - - !-------------------------------------------------------------------------------------------------- !> @brief reads integer value at myChunk from fixed format string !-------------------------------------------------------------------------------------------------- @@ -836,6 +757,7 @@ integer(pInt) function IO_fixedIntValue(string,ends,myChunk) VALIDCHARACTERS,MYNAME) end function IO_fixedIntValue +#endif !-------------------------------------------------------------------------------------------------- @@ -861,292 +783,6 @@ pure function IO_lc(string) end function IO_lc -!-------------------------------------------------------------------------------------------------- -!> @brief reads file to skip (at least) N chunks (may be over multiple lines) -!-------------------------------------------------------------------------------------------------- -subroutine IO_skipChunks(fileUnit,N) - - implicit none - integer(pInt), intent(in) :: fileUnit, & !< file handle - N !< minimum number of chunks to skip - - integer(pInt) :: remainingChunks - character(len=65536) :: line - - line = '' - remainingChunks = N - - do while (trim(line) /= IO_EOF .and. remainingChunks > 0) - line = IO_read(fileUnit) - remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt - enddo -end subroutine IO_skipChunks - - -!-------------------------------------------------------------------------------------------------- -!> @brief extracts string value from key=value pair and check whether key matches -!-------------------------------------------------------------------------------------------------- -character(len=300) pure function IO_extractValue(pair,key) - - implicit none - character(len=*), intent(in) :: pair, & !< key=value pair - key !< key to be expected - - character(len=*), parameter :: SEP = achar(61) ! '=' - - integer :: myChunk !< position number of desired chunk - - IO_extractValue = '' - - myChunk = scan(pair,SEP) - if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches - -end function IO_extractValue - - -!-------------------------------------------------------------------------------------------------- -!> @brief count lines containig data up to next *keyword -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countDataLines(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp - - IO_countDataLines = 0_pInt - line = '' - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - else - if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt - endif - enddo - backspace(fileUnit) - -end function IO_countDataLines - - -!-------------------------------------------------------------------------------------------------- -!> @brief count lines containig data up to next *keyword -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countNumericalDataLines(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line, & - tmp - - IO_countNumericalDataLines = 0_pInt - line = '' - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),'0123456789') == 0) then ! numerical values - IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt - else - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - enddo - backspace(fileUnit) - -end function IO_countNumericalDataLines - -!-------------------------------------------------------------------------------------------------- -!> @brief count items in consecutive lines depending on lines -!> @details Marc: ints concatenated by "c" as last char or range of values a "to" b -!> Abaqus: triplet of start,stop,inc -!> Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countContinuousIntValues(fileUnit) - - implicit none - integer(pInt), intent(in) :: fileUnit - -#ifdef Abaqus - integer(pInt) :: l,c -#endif - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line - - IO_countContinuousIntValues = 0_pInt - line = '' - -#ifndef Abaqus - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - if (chunkPos(1) < 1_pInt) then ! empty line - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - elseif (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator - IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & - - IO_intValue(line,chunkPos,1_pInt)) - line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! only one single range indicator allowed - else if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'of' ) then ! found multiple entries indicator - IO_countContinuousIntValues = IO_intValue(line,chunkPos,1_pInt) - line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! only one single multiplier allowed - else - IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' - if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value - IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt - line = IO_read(fileUnit, .true.) ! reset IO_read - exit ! data ended - endif - endif - enddo -#else - c = IO_countDataLines(fileUnit) - do l = 1_pInt,c - backspace(fileUnit) ! ToDo: substitute by rewind? - enddo - - l = 1_pInt - do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct - l = l + 1_pInt - line = IO_read(fileUnit) - chunkPos = IO_stringPos(line) - IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation - (IO_intValue(line,chunkPos,2_pInt)-IO_intValue(line,chunkPos,1_pInt))/& - max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) - enddo -#endif - -end function IO_countContinuousIntValues - - -!-------------------------------------------------------------------------------------------------- -!> @brief return integer list corresponding to items in consecutive lines. -!! First integer in array is counter -!> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set -!! Abaqus: triplet of start,stop,inc or named set -!! Spectral: ints concatenated range of a "to" b, multiple entries with a "of" b -!-------------------------------------------------------------------------------------------------- -function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) - - implicit none - integer(pInt), intent(in) :: maxN - integer(pInt), dimension(1+maxN) :: IO_continuousIntValues - - integer(pInt), intent(in) :: fileUnit, & - lookupMaxN - integer(pInt), dimension(:,:), intent(in) :: lookupMap - character(len=64), dimension(:), intent(in) :: lookupName - integer(pInt) :: i,first,last -#ifdef Abaqus - integer(pInt) :: j,l,c -#endif - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) line - logical rangeGeneration - - IO_continuousIntValues = 0_pInt - rangeGeneration = .false. - -#ifndef Abaqus - do - read(fileUnit,'(A65536)',end=100) line - chunkPos = IO_stringPos(line) - if (chunkPos(1) < 1_pInt) then ! empty line - exit - elseif (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name - do i = 1_pInt, lookupMaxN ! loop over known set names - if (IO_stringValue(line,chunkPos,1_pInt) == lookupName(i)) then ! found matching name - IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list - exit - endif - enddo - exit - else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator - first = IO_intValue(line,chunkPos,1_pInt) - last = IO_intValue(line,chunkPos,3_pInt) - do i = first, last, sign(1_pInt,last-first) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = i - enddo - exit - else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'of' ) then ! found multiple entries indicator - IO_continuousIntValues(1) = IO_intValue(line,chunkPos,1_pInt) - IO_continuousIntValues(2:IO_continuousIntValues(1)+1) = IO_intValue(line,chunkPos,3_pInt) - exit - else - do i = 1_pInt,chunkPos(1)-1_pInt ! interpret up to second to last value - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) - enddo - if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,chunkPos(1)) - exit - endif - endif - enddo -#else - c = IO_countDataLines(fileUnit) - do l = 1_pInt,c - backspace(fileUnit) - enddo - -!-------------------------------------------------------------------------------------------------- -! check if the element values in the elset are auto generated - backspace(fileUnit) - read(fileUnit,'(A65536)',end=100) line - chunkPos = IO_stringPos(line) - do i = 1_pInt,chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. - enddo - - do l = 1_pInt,c - read(fileUnit,'(A65536)',end=100) line - chunkPos = IO_stringPos(line) - if (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line - do i = 1_pInt,chunkPos(1) ! loop over set names in line - do j = 1_pInt,lookupMaxN ! look through known set names - if (IO_stringValue(line,chunkPos,i) == lookupName(j)) then ! found matching name - first = 2_pInt + IO_continuousIntValues(1) ! where to start appending data - last = first + lookupMap(1,j) - 1_pInt ! up to where to append data - IO_continuousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list - IO_continuousIntValues(1) = IO_continuousIntValues(1) + lookupMap(1,j) ! count them - endif - enddo - enddo - else if (rangeGeneration) then ! range generation - do i = IO_intValue(line,chunkPos,1_pInt),& - IO_intValue(line,chunkPos,2_pInt),& - max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = i - enddo - else ! read individual elem nums - do i = 1_pInt,chunkPos(1) - IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt - IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) - enddo - endif - enddo -#endif - -100 end function IO_continuousIntValues - - !-------------------------------------------------------------------------------------------------- !> @brief returns format string for integer values without leading zeros !-------------------------------------------------------------------------------------------------- @@ -1344,11 +980,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) ! DAMASK_marc errors case (700_pInt) msg = 'invalid materialpoint result requested' - case (701_pInt) - msg = 'not supported input file format, use Marc 2016 or earlier' !------------------------------------------------------------------------------------------------- -! errors related to spectral solver +! errors related to the grid solver case (809_pInt) msg = 'initializing FFTW' case (810_pInt) @@ -1370,13 +1004,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (841_pInt) msg = 'missing header length info in spectral mesh' case (842_pInt) - msg = 'homogenization in spectral mesh' - case (843_pInt) - msg = 'grid in spectral mesh' - case (844_pInt) - msg = 'size in spectral mesh' - case (845_pInt) msg = 'incomplete information in spectral mesh header' + case (843_pInt) + msg = 'microstructure count mismatch' case (846_pInt) msg = 'rotation for load case rotation ill-defined (R:RT != I)' case (847_pInt) @@ -1542,6 +1172,289 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) end subroutine IO_warning +#if defined(Abaqus) || defined(Marc4DAMASK) + +#ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @brief extracts string value from key=value pair and check whether key matches +!-------------------------------------------------------------------------------------------------- +character(len=300) pure function IO_extractValue(pair,key) + + implicit none + character(len=*), intent(in) :: pair, & !< key=value pair + key !< key to be expected + + character(len=*), parameter :: SEP = achar(61) ! '=' + + integer :: myChunk !< position number of desired chunk + + IO_extractValue = '' + + myChunk = scan(pair,SEP) + if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches + +end function IO_extractValue + + +!-------------------------------------------------------------------------------------------------- +!> @brief count lines containig data up to next *keyword +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_countDataLines(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit !< file handle + + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp + + IO_countDataLines = 0_pInt + line = '' + + do while (trim(line) /= IO_EOF) + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + else + if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt + endif + enddo + backspace(fileUnit) + +end function IO_countDataLines +#endif + + +#ifdef Marc4DAMASK +!-------------------------------------------------------------------------------------------------- +!> @brief count lines containig data up to next *keyword +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_countNumericalDataLines(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit !< file handle + + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp + + IO_countNumericalDataLines = 0_pInt + line = '' + + do while (trim(line) /= IO_EOF) + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),'0123456789') == 0) then ! numerical values + IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt + else + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + endif + enddo + backspace(fileUnit) + +end function IO_countNumericalDataLines + + +!-------------------------------------------------------------------------------------------------- +!> @brief reads file to skip (at least) N chunks (may be over multiple lines) +!-------------------------------------------------------------------------------------------------- +subroutine IO_skipChunks(fileUnit,N) + + implicit none + integer(pInt), intent(in) :: fileUnit, & !< file handle + N !< minimum number of chunks to skip + + integer(pInt) :: remainingChunks + character(len=65536) :: line + + line = '' + remainingChunks = N + + do while (trim(line) /= IO_EOF .and. remainingChunks > 0) + line = IO_read(fileUnit) + remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt + enddo +end subroutine IO_skipChunks +#endif + + +!-------------------------------------------------------------------------------------------------- +!> @brief count items in consecutive lines depending on lines +!> @details Marc: ints concatenated by "c" as last char or range of values a "to" b +!> Abaqus: triplet of start,stop,inc +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_countContinuousIntValues(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit + +#ifdef Abaqus + integer(pInt) :: l,c +#endif + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line + + IO_countContinuousIntValues = 0_pInt + line = '' + +#if defined(Marc4DAMASK) + do while (trim(line) /= IO_EOF) + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + if (chunkPos(1) < 1_pInt) then ! empty line + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + elseif (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator + IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & + - IO_intValue(line,chunkPos,1_pInt)) + line = IO_read(fileUnit, .true.) ! reset IO_read + exit ! only one single range indicator allowed + else + IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' + if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value + IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt + line = IO_read(fileUnit, .true.) ! reset IO_read + exit ! data ended + endif + endif + enddo +#elif defined(Abaqus) + c = IO_countDataLines(fileUnit) + do l = 1_pInt,c + backspace(fileUnit) + enddo + + l = 1_pInt + do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct? + l = l + 1_pInt + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + IO_countContinuousIntValues = IO_countContinuousIntValues + 1_pInt + & ! assuming range generation + (IO_intValue(line,chunkPos,2_pInt)-IO_intValue(line,chunkPos,1_pInt))/& + max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) + enddo +#endif + +end function IO_countContinuousIntValues + + +!-------------------------------------------------------------------------------------------------- +!> @brief return integer list corresponding to items in consecutive lines. +!! First integer in array is counter +!> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set +!! Abaqus: triplet of start,stop,inc or named set +!-------------------------------------------------------------------------------------------------- +function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) + + implicit none + integer(pInt), intent(in) :: maxN + integer(pInt), dimension(1+maxN) :: IO_continuousIntValues + + integer(pInt), intent(in) :: fileUnit, & + lookupMaxN + integer(pInt), dimension(:,:), intent(in) :: lookupMap + character(len=64), dimension(:), intent(in) :: lookupName + integer(pInt) :: i,first,last +#ifdef Abaqus + integer(pInt) :: j,l,c +#endif + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) line + logical rangeGeneration + + IO_continuousIntValues = 0_pInt + rangeGeneration = .false. + +#if defined(Marc4DAMASK) + do + read(fileUnit,'(A65536)',end=100) line + chunkPos = IO_stringPos(line) + if (chunkPos(1) < 1_pInt) then ! empty line + exit + elseif (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set name + do i = 1_pInt, lookupMaxN ! loop over known set names + if (IO_stringValue(line,chunkPos,1_pInt) == lookupName(i)) then ! found matching name + IO_continuousIntValues = lookupMap(:,i) ! return resp. entity list + exit + endif + enddo + exit + else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator + first = IO_intValue(line,chunkPos,1_pInt) + last = IO_intValue(line,chunkPos,3_pInt) + do i = first, last, sign(1_pInt,last-first) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = i + enddo + exit + else + do i = 1_pInt,chunkPos(1)-1_pInt ! interpret up to second to last value + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) + enddo + if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,chunkPos(1)) + exit + endif + endif + enddo +#elif defined(Abaqus) + c = IO_countDataLines(fileUnit) + do l = 1_pInt,c + backspace(fileUnit) + enddo + +!-------------------------------------------------------------------------------------------------- +! check if the element values in the elset are auto generated + backspace(fileUnit) + read(fileUnit,'(A65536)',end=100) line + chunkPos = IO_stringPos(line) + do i = 1_pInt,chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. + enddo + + do l = 1_pInt,c + read(fileUnit,'(A65536)',end=100) line + chunkPos = IO_stringPos(line) + if (verify(IO_stringValue(line,chunkPos,1_pInt),'0123456789') > 0) then ! a non-int, i.e. set names follow on this line + do i = 1_pInt,chunkPos(1) ! loop over set names in line + do j = 1_pInt,lookupMaxN ! look through known set names + if (IO_stringValue(line,chunkPos,i) == lookupName(j)) then ! found matching name + first = 2_pInt + IO_continuousIntValues(1) ! where to start appending data + last = first + lookupMap(1,j) - 1_pInt ! up to where to append data + IO_continuousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list + IO_continuousIntValues(1) = IO_continuousIntValues(1) + lookupMap(1,j) ! count them + endif + enddo + enddo + else if (rangeGeneration) then ! range generation + do i = IO_intValue(line,chunkPos,1_pInt),& + IO_intValue(line,chunkPos,2_pInt),& + max(1_pInt,IO_intValue(line,chunkPos,3_pInt)) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = i + enddo + else ! read individual elem nums + do i = 1_pInt,chunkPos(1) + IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt + IO_continuousIntValues(1+IO_continuousIntValues(1)) = IO_intValue(line,chunkPos,i) + enddo + endif + enddo +#endif + +100 end function IO_continuousIntValues +#endif + !-------------------------------------------------------------------------------------------------- ! internal helper functions @@ -1601,57 +1514,4 @@ real(pReal) function IO_verifyFloatValue (string,validChars,myName) end function IO_verifyFloatValue -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief create a new input file for abaqus simulations by removing all comment lines and -!> including "include"s -!-------------------------------------------------------------------------------------------------- -recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) - - implicit none - integer(pInt), intent(in) :: unit1, & - unit2 - - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line,fname - logical :: createSuccess,fexist - - - do - read(unit2,'(A65536)',END=220) line - chunkPos = IO_stringPos(line) - - if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then - fname = trim(line(9+scan(line(9:),'='):)) - inquire(file=fname, exist=fexist) - if (.not.(fexist)) then - !$OMP CRITICAL (write2out) - write(6,*)'ERROR: file does not exist error in abaqus_assembleInputFile' - write(6,*)'filename: ', trim(fname) - !$OMP END CRITICAL (write2out) - createSuccess = .false. - return - endif - open(unit2+1,err=200,status='old',file=fname) - if (abaqus_assembleInputFile(unit1,unit2+1_pInt)) then - createSuccess=.true. - close(unit2+1) - else - createSuccess=.false. - return - endif - else if (line(1:2) /= '**' .OR. line(1:8)=='**damask') then - write(unit1,'(A)') trim(line) - endif - enddo - -220 createSuccess = .true. - return - -200 createSuccess =.false. - -end function abaqus_assembleInputFile -#endif - end module IO diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 4feb52bed..d2765929f 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -12,7 +12,14 @@ #endif #include "math.f90" #include "FEsolving.f90" -#include "mesh.f90" +#include "element.f90" +#include "mesh_base.f90" +#ifdef Abaqus +#include "mesh_abaqus.f90" +#endif +#ifdef Marc4DAMASK +#include "mesh_marc.f90" +#endif #include "material.f90" #include "lattice.f90" #include "source_thermal_dissipation.f90" diff --git a/src/compilation_info.f90 b/src/compilation_info.f90 index 77d181a38..e69de29bb 100644 --- a/src/compilation_info.f90 +++ b/src/compilation_info.f90 @@ -1,14 +0,0 @@ -! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - write(6,*) 'Compiled with ', compiler_version() - write(6,*) 'With options ', compiler_options() -#elif defined(__INTEL_COMPILER) - write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,& - ', build date ', __INTEL_COMPILER_BUILD_DATE -#elif defined(__PGI) - write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version ', __PGIC__,& - '.', __PGIC_MINOR__ -#endif -write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__ -write(6,*) -flush(6) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a0d7147a6..ac8ee0484 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -56,12 +56,9 @@ subroutine constitutive_init() IO_checkAndRewind, & IO_open_jobFile_stat, & IO_write_jobFile, & - IO_write_jobIntFile, & IO_timeStamp use config, only: & config_phase - use mesh, only: & - FE_geomtype use config, only: & material_Nphase, & material_localFileExt, & @@ -790,8 +787,7 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac math_sym33to6, & math_mul33x33 use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & phasememberAt, & phase_plasticityInstance, & @@ -842,9 +838,9 @@ subroutine constitutive_collectDotState(S6, FeArray, Fi, FpArray, subdt, subfrac el !< element real(pReal), intent(in) :: & subdt !< timestep - real(pReal), intent(in), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + real(pReal), intent(in), dimension(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & subfracArray !< subfraction of timestep - real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & FeArray, & !< elastic deformation gradient FpArray !< plastic deformation gradient real(pReal), intent(in), dimension(3,3) :: & @@ -1004,8 +1000,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) math_6toSym33, & math_mul33x33 use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & phasememberAt, & phase_plasticityInstance, & @@ -1061,7 +1056,7 @@ function constitutive_postResults(S6, Fi, FeArray, ipc, ip, el) constitutive_postResults real(pReal), intent(in), dimension(3,3) :: & Fi !< intermediate deformation gradient - real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + real(pReal), intent(in), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & FeArray !< elastic deformation gradient real(pReal), intent(in), dimension(6) :: & S6 !< 2nd Piola Kirchhoff stress (vector notation) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 45aca46d1..c272abd07 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -12,8 +12,6 @@ module crystallite use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP - use mesh, only: & - mesh_element use material, only: & homogenization_Ngrains use prec, only: & @@ -155,10 +153,8 @@ subroutine crystallite_init math_inv33, & math_mul33x33 use mesh, only: & - mesh_element, & - mesh_NcpElems, & - mesh_maxNips, & - mesh_maxNipNeighbors + theMesh, & + mesh_element use IO, only: & IO_timeStamp, & IO_stringValue, & @@ -196,8 +192,8 @@ subroutine crystallite_init #include "compilation_info.f90" cMax = homogenization_maxNgrains - iMax = mesh_maxNips - eMax = mesh_NcpElems + iMax = theMesh%elem%nIPs + eMax = theMesh%nElems ! --------------------------------------------------------------------------- ! ToDo (when working on homogenization): should be 3x3 tensor called S @@ -333,7 +329,7 @@ subroutine crystallite_init case(elasmatrix_ID) mySize = 36_pInt case(neighboringip_ID,neighboringelement_ID) - mySize = mesh_maxNipNeighbors + mySize = theMesh%elem%nIPneighbors case default mySize = 0_pInt end select @@ -415,7 +411,7 @@ subroutine crystallite_init write(6,'(a42,1x,i10)') ' # of elements: ', eMax write(6,'(a42,1x,i10)') 'max # of integration points/element: ', iMax write(6,'(a42,1x,i10)') 'max # of constituents/integration point: ', cMax - write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', mesh_maxNipNeighbors + write(6,'(a42,1x,i10)') 'max # of neigbours/integration point: ', theMesh%elem%nIPneighbors write(6,'(a42,1x,i10)') ' # of nonlocal constituents: ',count(.not. crystallite_localPlasticity) flush(6) endif @@ -430,7 +426,7 @@ end subroutine crystallite_init !-------------------------------------------------------------------------------------------------- !> @brief calculate stress (P) !-------------------------------------------------------------------------------------------------- -function crystallite_stress() +function crystallite_stress(a) use prec, only: & tol_math_check, & dNeq0 @@ -458,10 +454,8 @@ function crystallite_stress() math_6toSym33, & math_sym33to6 use mesh, only: & - mesh_NcpElems, & - mesh_element, & - mesh_maxNips, & - FE_geomtype + theMesh, & + mesh_element use material, only: & homogenization_Ngrains, & plasticState, & @@ -474,7 +468,8 @@ function crystallite_stress() constitutive_LiAndItsTangents implicit none - logical, dimension(mesh_maxNips,mesh_NcpElems) :: crystallite_stress + logical, dimension(theMesh%elem%nIPs,theMesh%Nelems) :: crystallite_stress + real(pReal), intent(in), optional :: a !ToDo: for some reason this prevents an internal compiler error in GNU. Very strange real(pReal) :: & formerSubStep integer(pInt) :: & @@ -541,7 +536,7 @@ function crystallite_stress() endIP = startIP else singleRun startIP = 1_pInt - endIP = mesh_maxNips + endIP = theMesh%elem%nIPs endif singleRun NiterationCrystallite = 0_pInt @@ -727,8 +722,7 @@ subroutine crystallite_stressTangent() math_invert2, & math_det33 use mesh, only: & - mesh_element, & - FE_geomtype + mesh_element use material, only: & homogenization_Ngrains use constitutive, only: & @@ -929,7 +923,7 @@ function crystallite_push33ToRef(ipc,ip,el, tensor33) math_inv33, & math_EulerToR use material, only: & - material_EulerAngles + material_EulerAngles ! ToDo: Why stored? We also have crystallite_orientation0 implicit none real(pReal), dimension(3,3) :: crystallite_push33ToRef @@ -960,13 +954,10 @@ function crystallite_postResults(ipc, ip, el) inDeg, & math_6toSym33 use mesh, only: & + theMesh, & mesh_element, & mesh_ipVolume, & - mesh_maxNipNeighbors, & - mesh_ipNeighborhood, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype + mesh_ipNeighborhood use material, only: & plasticState, & sourceState, & @@ -1070,14 +1061,14 @@ function crystallite_postResults(ipc, ip, el) mySize = 36_pInt crystallite_postResults(c+1:c+mySize) = reshape(constitutive_homogenizedC(ipc,ip,el),[mySize]) case(neighboringelement_ID) - mySize = mesh_maxNipNeighbors + mySize = theMesh%elem%nIPneighbors crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1_pInt:FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) & + forall (n = 1_pInt:mySize) & crystallite_postResults(c+n) = real(mesh_ipNeighborhood(1,n,ip,el),pReal) case(neighboringip_ID) - mySize = mesh_maxNipNeighbors + mySize = theMesh%elem%nIPneighbors crystallite_postResults(c+1:c+mySize) = 0.0_pReal - forall (n = 1_pInt:FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) & + forall (n = 1_pInt:mySize) & crystallite_postResults(c+n) = real(mesh_ipNeighborhood(2,n,ip,el),pReal) end select c = c + mySize @@ -1754,9 +1745,8 @@ end subroutine integrateStateEuler !-------------------------------------------------------------------------------------------------- subroutine integrateStateAdaptiveEuler() use mesh, only: & - mesh_element, & - mesh_NcpElems, & - mesh_maxNips + theMesh, & + mesh_element use material, only: & homogenization_Ngrains, & plasticState, & @@ -1780,11 +1770,11 @@ subroutine integrateStateAdaptiveEuler() ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of adaptive Euler real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_plastic real(pReal), dimension(constitutive_source_maxSizeDotState,& maxval(phase_Nsources), & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_source !-------------------------------------------------------------------------------------------------- @@ -1931,8 +1921,7 @@ end subroutine integrateStateRK4 subroutine integrateStateRKCK45() use mesh, only: & mesh_element, & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & homogenization_Ngrains, & plasticState, & @@ -1979,11 +1968,11 @@ subroutine integrateStateRKCK45() ! ToDo: MD: once all constitutives use allocate state, attach residuum arrays to the state in case of RKCK45 real(pReal), dimension(constitutive_plasticity_maxSizeDotState, & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_plastic ! relative residuum from evolution in microstructure real(pReal), dimension(constitutive_source_maxSizeDotState, & maxval(phase_Nsources), & - homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems) :: & + homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems) :: & residuum_source ! relative residuum from evolution in microstructure @@ -2128,7 +2117,8 @@ end subroutine nonlocalConvergenceCheck !> @details: For explicitEuler, RK4 and RKCK45, adaptive Euler and FPI have their on criteria !-------------------------------------------------------------------------------------------------- subroutine setConvergenceFlag() - + use mesh, only: & + mesh_element implicit none integer(pInt) :: & e, & !< element index in element loop @@ -2168,7 +2158,8 @@ 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 @@ -2200,6 +2191,8 @@ end subroutine update_stress !> @brief tbd !-------------------------------------------------------------------------------------------------- subroutine update_dependentState() + use mesh, only: & + mesh_element use constitutive, only: & constitutive_dependentState => constitutive_microstructure @@ -2232,6 +2225,8 @@ subroutine update_state(timeFraction) sourceState, & phase_Nsources, & phaseAt, phasememberAt + use mesh, only: & + mesh_element implicit none real(pReal), intent(in) :: & @@ -2281,6 +2276,8 @@ subroutine update_dotState(timeFraction) sourceState, & phaseAt, phasememberAt, & phase_Nsources + use mesh, only: & + mesh_element use constitutive, only: & constitutive_collectDotState @@ -2334,6 +2331,8 @@ subroutine update_deltaState IEEE_arithmetic use prec, only: & dNeq0 + use mesh, only: & + mesh_element use material, only: & plasticState, & sourceState, & @@ -2429,6 +2428,8 @@ logical function stateJump(ipc,ip,el) sourceState, & phase_Nsources, & phaseAt, phasememberAt + use mesh, only: & + mesh_element use constitutive, only: & constitutive_collectDeltaState use math, only: & diff --git a/src/element.f90 b/src/element.f90 new file mode 100644 index 000000000..473d9c73c --- /dev/null +++ b/src/element.f90 @@ -0,0 +1,921 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!-------------------------------------------------------------------------------------------------- +module element + use prec, only: & + pInt, & + pReal + + implicit none + private + +!--------------------------------------------------------------------------------------------------- +!> Properties of a single element (the element used in the mesh) +!--------------------------------------------------------------------------------------------------- + type, public :: tElement + integer(pInt) :: & + elemType, & + geomType, & ! geometry type (same for same dimension and same number of integration points) + cellType, & + Nnodes, & + Ncellnodes, & + NcellnodesPerCell, & + nIPs, & + nIPneighbors, & ! ToDo: MD: Do all IPs in one element type have the same number of neighbors? + maxNnodeAtIP + integer(pInt), dimension(:,:), allocatable :: & + Cell, & ! intra-element (cell) nodes that constitute a cell + NnodeAtIP, & + IPneighbor, & + cellFace + real(pReal), dimension(:,:), allocatable :: & + ! center of gravity of the weighted nodes gives the position of the cell node. + ! example: face-centered cell node with face nodes 1,2,5,6 to be used in, + ! e.g., an 8 node element, would be encoded: + ! 1, 1, 0, 0, 1, 1, 0, 0 + cellNodeParentNodeWeights + contains + procedure :: init => tElement_init + end type + + integer(pInt), parameter, private :: & + NELEMTYPE = 13_pInt + + integer(pInt), dimension(NelemType), parameter, private :: NNODE = & + int([ & + 3, & ! 2D 3node 1ip + 6, & ! 2D 6node 3ip + 4, & ! 2D 4node 4ip + 8, & ! 2D 8node 9ip + 8, & ! 2D 8node 4ip + !-------------------- + 4, & ! 3D 4node 1ip + 5, & ! 3D 5node 4ip + 10, & ! 3D 10node 4ip + 6, & ! 3D 6node 6ip + 8, & ! 3D 8node 1ip + 8, & ! 3D 8node 8ip + 20, & ! 3D 20node 8ip + 20 & ! 3D 20node 27ip + ],pInt) !< number of nodes that constitute a specific type of element + + integer(pInt), dimension(NelemType), parameter, public :: GEOMTYPE = & + int([ & + 1, & ! 2D 3node 1ip + 2, & ! 2D 6node 3ip + 3, & ! 2D 4node 4ip + 4, & ! 2D 8node 9ip + 3, & ! 2D 8node 4ip + !-------------------- + 5, & ! 3D 4node 1ip + 6, & ! 3D 5node 4ip + 6, & ! 3D 10node 4ip + 7, & ! 3D 6node 6ip + 8, & ! 3D 8node 1ip + 9, & ! 3D 8node 8ip + 9, & ! 3D 20node 8ip + 10 & ! 3D 20node 27ip + ],pInt) !< geometry type of particular element type + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: NCELLNODE = & ! Intel 16.0 complains + integer(pInt), dimension(10), parameter, private :: NCELLNODE = & + int([ & + 3, & + 7, & + 9, & + 16, & + 4, & + 15, & + 21, & + 8, & + 27, & + 64 & + ],pInt) !< number of cell nodes in a specific geometry type + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: NIP = & ! Intel 16.0 complains + integer(pInt), dimension(10), parameter, private :: NIP = & + int([ & + 1, & + 3, & + 4, & + 9, & + 1, & + 4, & + 6, & + 1, & + 8, & + 27 & + ],pInt) !< number of IPs in a specific geometry type + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: CELLTYPE = & ! Intel 16.0 complains + integer(pInt), dimension(10), parameter, private :: CELLTYPE = & !< cell type that is used by each geometry type + int([ & + 1, & ! 2D 3node + 2, & ! 2D 4node + 2, & ! 2D 4node + 2, & ! 2D 4node + 3, & ! 3D 4node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4, & ! 3D 8node + 4 & ! 3D 8node + ],pInt) + + !integer(pInt), dimension(maxval(cellType)), parameter, private :: nIPNeighbor = & ! causes problem with Intel 16.0 + integer(pInt), dimension(4), parameter, private :: NIPNEIGHBOR = & !< number of ip neighbors / cell faces in a specific cell type + int([& + 3, & ! 2D 3node + 4, & ! 2D 4node + 4, & ! 3D 4node + 6 & ! 3D 8node + ],pInt) + + !integer(pInt), dimension(maxval(cellType)), parameter, private :: NCELLNODESPERCELLFACE = & + integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELLFACE = & !< number of cell nodes in a specific cell type + int([ & + 2, & ! 2D 3node + 2, & ! 2D 4node + 3, & ! 3D 4node + 4 & ! 3D 8node + ],pInt) + + !integer(pInt), dimension(maxval(geomType)), parameter, private :: maxNodeAtIP = & ! causes problem with Intel 16.0 + integer(pInt), dimension(10), parameter, private :: maxNnodeAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element + int([ & + 3, & + 1, & + 1, & + 2, & + 4, & + 1, & + 1, & + 8, & + 1, & + 4 & + ],pInt) + + + !integer(pInt), dimension(maxval(CELLTYPE)), parameter, private :: NCELLNODEPERCELL = & ! Intel 16.0 complains + integer(pInt), dimension(4), parameter, private :: NCELLNODEPERCELL = & !< number of cell nodes in a specific cell type + int([ & + 3, & ! 2D 3node + 4, & ! 2D 4node + 4, & ! 3D 4node + 8 & ! 3D 8node + ],pInt) + + integer(pInt), dimension(maxNnodeAtIP(1),nIP(1)), parameter, private :: NnodeAtIP1 = & + reshape(int([& + 1,2,3 & + ],pInt),[maxNnodeAtIP(1),nIP(1)]) + + integer(pInt), dimension(maxNnodeAtIP(2),nIP(2)), parameter, private :: NnodeAtIP2 = & + reshape(int([& + 1, & + 2, & + 3 & + ],pInt),[maxNnodeAtIP(2),nIP(2)]) + + integer(pInt), dimension(maxNnodeAtIP(3),nIP(3)), parameter, private :: NnodeAtIP3 = & + reshape(int([& + 1, & + 2, & + 4, & + 3 & + ],pInt),[maxNnodeAtIP(3),nIP(3)]) + + integer(pInt), dimension(maxNnodeAtIP(4),nIP(4)), parameter, private :: NnodeAtIP4 = & + reshape(int([& + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],pInt),[maxNnodeAtIP(4),nIP(4)]) + + integer(pInt), dimension(maxNnodeAtIP(5),nIP(5)), parameter, private :: NnodeAtIP5 = & + reshape(int([& + 1,2,3,4 & + ],pInt),[maxNnodeAtIP(5),nIP(5)]) + + integer(pInt), dimension(maxNnodeAtIP(6),nIP(6)), parameter, private :: NnodeAtIP6 = & + reshape(int([& + 1, & + 2, & + 3, & + 4 & + ],pInt),[maxNnodeAtIP(6),nIP(6)]) + + integer(pInt), dimension(maxNnodeAtIP(7),nIP(7)), parameter, private :: NnodeAtIP7 = & + reshape(int([& + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & + ],pInt),[maxNnodeAtIP(7),nIP(7)]) + + integer(pInt), dimension(maxNnodeAtIP(8),nIP(8)), parameter, private :: NnodeAtIP8 = & + reshape(int([& + 1,2,3,4,5,6,7,8 & + ],pInt),[maxNnodeAtIP(8),nIP(8)]) + + integer(pInt), dimension(maxNnodeAtIP(9),nIP(9)), parameter, private :: NnodeAtIP9 = & + reshape(int([& + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & + ],pInt),[maxNnodeAtIP(9),nIP(9)]) + + integer(pInt), dimension(maxNnodeAtIP(10),nIP(10)), parameter, private :: NnodeAtIP10 = & + reshape(int([& + 1,0, 0,0, & + 1,2, 0,0, & + 2,0, 0,0, & + 1,4, 0,0, & + 1,3, 2,4, & + 2,3, 0,0, & + 4,0, 0,0, & + 3,4, 0,0, & + 3,0, 0,0, & + 1,5, 0,0, & + 1,6, 2,5, & + 2,6, 0,0, & + 1,8, 4,5, & + 0,0, 0,0, & + 2,7, 3,6, & + 4,8, 0,0, & + 3,8, 4,7, & + 3,7, 0,0, & + 5,0, 0,0, & + 5,6, 0,0, & + 6,0, 0,0, & + 5,8, 0,0, & + 5,7, 6,8, & + 6,7, 0,0, & + 8,0, 0,0, & + 7,8, 0,0, & + 7,0, 0,0 & + ],pInt),[maxNnodeAtIP(10),nIP(10)]) + + ! *** FE_ipNeighbor *** + ! is a list of the neighborhood of each IP. + ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. + ! Positive integers denote an intra-FE IP identifier. + ! Negative integers denote the interface behind which the neighboring (extra-FE) IP will be located. + + + integer(pInt), dimension(nIPneighbor(cellType(1)),nIP(1)), parameter, private :: IPneighbor1 = & + reshape(int([& + -2,-3,-1 & + ],pInt),[nIPneighbor(cellType(1)),nIP(1)]) + + integer(pInt), dimension(nIPneighbor(cellType(2)),nIP(2)), parameter, private :: IPneighbor2 = & + reshape(int([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & + ],pInt),[nIPneighbor(cellType(2)),nIP(2)]) + + integer(pInt), dimension(nIPneighbor(cellType(3)),nIP(3)), parameter, private :: IPneighbor3 = & + reshape(int([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & + ],pInt),[nIPneighbor(cellType(3)),nIP(3)]) + + integer(pInt), dimension(nIPneighbor(cellType(4)),nIP(4)), parameter, private :: IPneighbor4 = & + reshape(int([& + 2,-4, 4,-1, & + 3, 1, 5,-1, & + -2, 2, 6,-1, & + 5,-4, 7, 1, & + 6, 4, 8, 2, & + -2, 5, 9, 3, & + 8,-4,-3, 4, & + 9, 7,-3, 5, & + -2, 8,-3, 6 & + ],pInt),[nIPneighbor(cellType(4)),nIP(4)]) + + integer(pInt), dimension(nIPneighbor(cellType(5)),nIP(5)), parameter, private :: IPneighbor5 = & + reshape(int([& + -1,-2,-3,-4 & + ],pInt),[nIPneighbor(cellType(5)),nIP(5)]) + + integer(pInt), dimension(nIPneighbor(cellType(6)),nIP(6)), parameter, private :: IPneighbor6 = & + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -2, 1, 3,-2, 4,-1, & + 2,-4,-3, 1, 4,-1, & + 2,-4, 3,-2,-3, 1 & + ],pInt),[nIPneighbor(cellType(6)),nIP(6)]) + + integer(pInt), dimension(nIPneighbor(cellType(7)),nIP(7)), parameter, private :: IPneighbor7 = & + reshape(int([& + 2,-4, 3,-2, 4,-1, & + -3, 1, 3,-2, 5,-1, & + 2,-4,-3, 1, 6,-1, & + 5,-4, 6,-2,-5, 1, & + -3, 4, 6,-2,-5, 2, & + 5,-4,-3, 4,-5, 3 & + ],pInt),[nIPneighbor(cellType(7)),nIP(7)]) + + integer(pInt), dimension(nIPneighbor(cellType(8)),nIP(8)), parameter, private :: IPneighbor8 = & + reshape(int([& + -3,-5,-4,-2,-6,-1 & + ],pInt),[nIPneighbor(cellType(8)),nIP(8)]) + + integer(pInt), dimension(nIPneighbor(cellType(9)),nIP(9)), parameter, private :: IPneighbor9 = & + reshape(int([& + 2,-5, 3,-2, 5,-1, & + -3, 1, 4,-2, 6,-1, & + 4,-5,-4, 1, 7,-1, & + -3, 3,-4, 2, 8,-1, & + 6,-5, 7,-2,-6, 1, & + -3, 5, 8,-2,-6, 2, & + 8,-5,-4, 5,-6, 3, & + -3, 7,-4, 6,-6, 4 & + ],pInt),[nIPneighbor(cellType(9)),nIP(9)]) + + integer(pInt), dimension(nIPneighbor(cellType(10)),nIP(10)), parameter, private :: IPneighbor10 = & + reshape(int([& + 2,-5, 4,-2,10,-1, & + 3, 1, 5,-2,11,-1, & + -3, 2, 6,-2,12,-1, & + 5,-5, 7, 1,13,-1, & + 6, 4, 8, 2,14,-1, & + -3, 5, 9, 3,15,-1, & + 8,-5,-4, 4,16,-1, & + 9, 7,-4, 5,17,-1, & + -3, 8,-4, 6,18,-1, & + 11,-5,13,-2,19, 1, & + 12,10,14,-2,20, 2, & + -3,11,15,-2,21, 3, & + 14,-5,16,10,22, 4, & + 15,13,17,11,23, 5, & + -3,14,18,12,24, 6, & + 17,-5,-4,13,25, 7, & + 18,16,-4,14,26, 8, & + -3,17,-4,15,27, 9, & + 20,-5,22,-2,-6,10, & + 21,19,23,-2,-6,11, & + -3,20,24,-2,-6,12, & + 23,-5,25,19,-6,13, & + 24,22,26,20,-6,14, & + -3,23,27,21,-6,15, & + 26,-5,-4,22,-6,16, & + 27,25,-4,23,-6,17, & + -3,26,-4,24,-6,18 & + ],pInt),[nIPneighbor(cellType(10)),nIP(10)]) + + + real(pReal), dimension(nNode(1),NcellNode(geomType(1))), parameter :: cellNodeParentNodeWeights1 = & + reshape(real([& + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & + ],pReal),[nNode(1),NcellNode(geomType(1))]) ! 2D 3node 1ip + + real(pReal), dimension(nNode(2),NcellNode(geomType(2))), parameter :: cellNodeParentNodeWeights2 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 2, 2, 2 & + ],pReal),[nNode(2),NcellNode(geomType(2))]) ! 2D 6node 3ip + + real(pReal), dimension(nNode(3),NcellNode(geomType(3))), parameter :: cellNodeParentNodeWeights3 = & + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1, & + 1, 1, 0, 0, & + 0, 1, 1, 0, & + 0, 0, 1, 1, & + 1, 0, 0, 1, & + 1, 1, 1, 1 & + ],pReal),[nNode(3),NcellNode(geomType(3))]) ! 2D 6node 3ip + + real(pReal), dimension(nNode(4),NcellNode(geomType(4))), parameter :: cellNodeParentNodeWeights4 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 1, 0, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 2, 0, 0, 0, & + 0, 1, 0, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 2, 0, 0, & + 0, 0, 1, 0, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 2, 0, & + 0, 0, 0, 1, 0, 0, 0, 2, & + 1, 0, 0, 0, 0, 0, 0, 2, & + 4, 1, 1, 1, 8, 2, 2, 8, & + 1, 4, 1, 1, 8, 8, 2, 2, & + 1, 1, 4, 1, 2, 8, 8, 2, & + 1, 1, 1, 4, 2, 2, 8, 8 & + ],pReal),[nNode(4),NcellNode(geomType(4))]) ! 2D 8node 9ip + + real(pReal), dimension(nNode(5),NcellNode(geomType(5))), parameter :: cellNodeParentNodeWeights5 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 1, 2, 2, 2, 2 & + ],pReal),[nNode(5),NcellNode(geomType(5))]) ! 2D 8node 4ip + + real(pReal), dimension(nNode(6),NcellNode(geomType(6))), parameter :: cellNodeParentNodeWeights6 = & + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & + ],pReal),[nNode(6),NcellNode(geomType(6))]) ! 3D 4node 1ip + + real(pReal), dimension(nNode(7),NcellNode(geomType(7))), parameter :: cellNodeParentNodeWeights7 = & + reshape(real([& + 1, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, & + 0, 0, 1, 0, 0, & + 0, 0, 0, 1, 0, & + 1, 1, 0, 0, 0, & + 0, 1, 1, 0, 0, & + 1, 0, 1, 0, 0, & + 1, 0, 0, 1, 0, & + 0, 1, 0, 1, 0, & + 0, 0, 1, 1, 0, & + 1, 1, 1, 0, 0, & + 1, 1, 0, 1, 0, & + 0, 1, 1, 1, 0, & + 1, 0, 1, 1, 0, & + 0, 0, 0, 0, 1 & + ],pReal),[nNode(7),NcellNode(geomType(7))]) ! 3D 5node 4ip + + real(pReal), dimension(nNode(8),NcellNode(geomType(8))), parameter :: cellNodeParentNodeWeights8 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & + 1, 1, 1, 0, 2, 2, 2, 0, 0, 0, & + 1, 1, 0, 1, 2, 0, 0, 2, 2, 0, & + 0, 1, 1, 1, 0, 2, 0, 0, 2, 2, & + 1, 0, 1, 1, 0, 0, 2, 2, 0, 2, & + 3, 3, 3, 3, 4, 4, 4, 4, 4, 4 & + ],pReal),[nNode(8),NcellNode(geomType(8))]) ! 3D 10node 4ip + + real(pReal), dimension(nNode(9),NcellNode(geomType(9))), parameter :: cellNodeParentNodeWeights9 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 1, & + 1, 1, 0, 0, 0, 0, & + 0, 1, 1, 0, 0, 0, & + 1, 0, 1, 0, 0, 0, & + 1, 0, 0, 1, 0, 0, & + 0, 1, 0, 0, 1, 0, & + 0, 0, 1, 0, 0, 1, & + 0, 0, 0, 1, 1, 0, & + 0, 0, 0, 0, 1, 1, & + 0, 0, 0, 1, 0, 1, & + 1, 1, 1, 0, 0, 0, & + 1, 1, 0, 1, 1, 0, & + 0, 1, 1, 0, 1, 1, & + 1, 0, 1, 1, 0, 1, & + 0, 0, 0, 1, 1, 1, & + 1, 1, 1, 1, 1, 1 & + ],pReal),[nNode(9),NcellNode(geomType(9))]) ! 3D 6node 6ip + + real(pReal), dimension(nNode(10),NcellNode(geomType(10))), parameter :: cellNodeParentNodeWeights10 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, 0, 0, & + 0, 0, 1, 0, 0, 0, 0, 0, & + 0, 0, 0, 1, 0, 0, 0, 0, & + 0, 0, 0, 0, 1, 0, 0, 0, & + 0, 0, 0, 0, 0, 1, 0, 0, & + 0, 0, 0, 0, 0, 0, 1, 0, & + 0, 0, 0, 0, 0, 0, 0, 1 & + ],pReal),[nNode(10),NcellNode(geomType(10))]) ! 3D 8node 1ip + + real(pReal), dimension(nNode(11),NcellNode(geomType(11))), parameter :: cellNodeParentNodeWeights11 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, & ! + 1, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 1, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 1, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 1, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 1, & ! + 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, & ! + 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, & ! + 1, 1, 1, 1, 1, 1, 1, 1 & ! + ],pReal),[nNode(11),NcellNode(geomType(11))]) ! 3D 8node 8ip + + real(pReal), dimension(nNode(12),NcellNode(geomType(12))), parameter :: cellNodeParentNodeWeights12 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! + 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! + 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! + ],pReal),[nNode(12),NcellNode(geomType(12))]) ! 3D 20node 8ip + + real(pReal), dimension(nNode(13),NcellNode(geomType(13))), parameter :: cellNodeParentNodeWeights13 = & + reshape(real([& + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 + 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! + 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 + 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! + 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! + 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! + 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 + 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! + 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 + 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! + 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! + 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 + 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! + 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! + 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! + 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! + 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 + 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! + 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! + 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! + 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! + ],pReal),[nNode(13),NcellNode(geomType(13))]) ! 3D 20node 27ip + + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)), parameter :: CELL1 = & + reshape(int([& + 1,2,3 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(1)),NIP(1)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)), parameter :: CELL2 = & + reshape(int([& + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(2)),NIP(2)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)), parameter :: CELL3 = & + reshape(int([& + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(3)),NIP(3)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)), parameter :: CELL4 = & + reshape(int([& + 1, 5,13,12, & + 5, 6,14,13, & + 6, 2, 7,14, & + 12,13,16,11, & + 13,14,15,16, & + 14, 7, 8,15, & + 11,16,10, 4, & + 16,15, 9,10, & + 15, 8, 3, 9 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(4)),NIP(4)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)), parameter :: CELL5 = & + reshape(int([& + 1, 2, 3, 4 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(5)),NIP(5)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)), parameter :: CELL6 = & + reshape(int([& + 1, 5,11, 7, 8,12,15,14, & + 5, 2, 6,11,12, 9,13,15, & + 7,11, 6, 3,14,15,13,10, & + 8,12,15, 4, 4, 9,13,10 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(6)),NIP(6)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)), parameter :: CELL7 = & + reshape(int([& + 1, 7,16, 9,10,17,21,19, & + 7, 2, 8,16,17,11,18,21, & + 9,16, 8, 3,19,21,18,12, & + 10,17,21,19, 4,13,20,15, & + 17,11,18,21,13, 5,14,20, & + 19,21,18,12,15,20,14, 6 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(7)),NIP(7)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)), parameter :: CELL8 = & + reshape(int([& + 1, 2, 3, 4, 5, 6, 7, 8 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(8)),NIP(8)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)), parameter :: CELL9 = & + reshape(int([& + 1, 9,21,12,13,22,27,25, & + 9, 2,10,21,22,14,23,27, & + 12,21,11, 4,25,27,24,16, & + 21,10, 3,11,27,23,15,24, & + 13,22,27,25, 5,17,26,20, & + 22,14,23,27,17, 6,18,26, & + 25,27,24,16,20,26,19, 8, & + 27,23,15,24,26,18, 7,19 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(9)),NIP(9)]) + + integer(pInt), dimension(NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)), parameter :: CELL10 = & + reshape(int([& + 1, 9,33,16,17,37,57,44, & + 9,10,34,33,37,38,58,57, & + 10, 2,11,34,38,18,39,58, & + 16,33,36,15,44,57,60,43, & + 33,34,35,36,57,58,59,60, & + 34,11,12,35,58,39,40,59, & + 15,36,14, 4,43,60,42,20, & + 36,35,13,14,60,59,41,42, & + 35,12, 3,13,59,40,19,41, & + 17,37,57,44,21,45,61,52, & + 37,38,58,57,45,46,62,61, & + 38,18,39,58,46,22,47,62, & + 44,57,60,43,52,61,64,51, & + 57,58,59,60,61,62,63,64, & + 58,39,40,59,62,47,48,63, & + 43,60,42,20,51,64,50,24, & + 60,59,41,42,64,63,49,50, & + 59,40,19,41,63,48,23,49, & + 21,45,61,52, 5,25,53,32, & + 45,46,62,61,25,26,54,53, & + 46,22,47,62,26, 6,27,54, & + 52,61,64,51,32,53,56,31, & + 61,62,63,64,53,54,55,56, & + 62,47,48,63,54,27,28,55, & + 51,64,50,24,31,56,30, 8, & + 64,63,49,50,56,55,29,30, & + 63,48,23,49,55,28, 7,29 & + ],pInt),[NCELLNODEPERCELL(CELLTYPE(10)),NIP(10)]) + + + integer(pInt), dimension(NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)), parameter :: CELLFACE1 = & + reshape(int([& + 2,3, & + 3,1, & + 1,2 & + ],pInt),[NCELLNODEPERCELLFACE(1),NIPNEIGHBOR(1)]) ! 2D 3node, VTK_TRIANGLE (5) + + integer(pInt), dimension(NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)), parameter :: CELLFACE2 = & + reshape(int([& + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],pInt),[NCELLNODEPERCELLFACE(2),NIPNEIGHBOR(2)]) ! 2D 4node, VTK_QUAD (9) + + integer(pInt), dimension(NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)), parameter :: CELLFACE3 = & + reshape(int([& + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],pInt),[NCELLNODEPERCELLFACE(3),NIPNEIGHBOR(3)]) ! 3D 4node, VTK_TETRA (10) + + integer(pInt), dimension(NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)), parameter :: CELLFACE4 = & + reshape(int([& + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],pInt),[NCELLNODEPERCELLFACE(4),NIPNEIGHBOR(4)]) ! 3D 8node, VTK_HEXAHEDRON (12) + + +contains + + subroutine tElement_init(self,elemType) + implicit none + class(tElement) :: self + integer(pInt), intent(in) :: elemType + self%elemType = elemType + + self%Nnodes = Nnode (self%elemType) + self%geomType = geomType (self%elemType) + select case (self%elemType) + case(1_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights1 + case(2_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights2 + case(3_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights3 + case(4_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights4 + case(5_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights5 + case(6_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights6 + case(7_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights7 + case(8_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights8 + case(9_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights9 + case(10_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights10 + case(11_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights11 + case(12_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights12 + case(13_pInt) + self%cellNodeParentNodeWeights = cellNodeParentNodeWeights13 + case default + print*, 'Mist' + end select + + + self%NcellNodes = NcellNode (self%geomType) + self%maxNnodeAtIP = maxNnodeAtIP (self%geomType) + self%nIPs = nIP (self%geomType) + self%cellType = cellType (self%geomType) + + + select case (self%geomType) + case(1_pInt) + self%NnodeAtIP = NnodeAtIP1 + self%IPneighbor = IPneighbor1 + self%cell = CELL1 + case(2_pInt) + self%NnodeAtIP = NnodeAtIP2 + self%IPneighbor = IPneighbor2 + self%cell = CELL2 + case(3_pInt) + self%NnodeAtIP = NnodeAtIP3 + self%IPneighbor = IPneighbor3 + self%cell = CELL3 + case(4_pInt) + self%NnodeAtIP = NnodeAtIP4 + self%IPneighbor = IPneighbor4 + self%cell = CELL4 + case(5_pInt) + self%NnodeAtIP = NnodeAtIP5 + self%IPneighbor = IPneighbor5 + self%cell = CELL5 + case(6_pInt) + self%NnodeAtIP = NnodeAtIP6 + self%IPneighbor = IPneighbor6 + self%cell = CELL6 + case(7_pInt) + self%NnodeAtIP = NnodeAtIP7 + self%IPneighbor = IPneighbor7 + self%cell = CELL7 + case(8_pInt) + self%NnodeAtIP = NnodeAtIP8 + self%IPneighbor = IPneighbor8 + self%cell = CELL8 + case(9_pInt) + self%NnodeAtIP = NnodeAtIP9 + self%IPneighbor = IPneighbor9 + self%cell = CELL9 + case(10_pInt) + self%NnodeAtIP = NnodeAtIP10 + self%IPneighbor = IPneighbor10 + self%cell = CELL10 + end select + self%NcellNodesPerCell = NCELLNODEPERCELL(self%cellType) + + select case(self%cellType) + case(1_pInt) + self%cellFace = CELLFACE1 + case(2_pInt) + self%cellFace = CELLFACE2 + case(3_pInt) + self%cellFace = CELLFACE3 + case(4_pInt) + self%cellFace = CELLFACE4 + end select + + self%nIPneighbors = size(self%IPneighbor,1) + + write(6,'(/,a)') ' <<<+- element_init -+>>>' + + write(6,*)' element type ',self%elemType + write(6,*)' geom type ',self%geomType + write(6,*)' cell type ',self%cellType + write(6,*)' # node ',self%Nnodes + write(6,*)' # IP ',self%nIPs + write(6,*)' # cellnode ',self%Ncellnodes + write(6,*)' # cellnode/cell ',self%NcellnodesPerCell + write(6,*)' # IP neighbor ',self%nIPneighbors + write(6,*)' max # node at IP ',self%maxNnodeAtIP + + end subroutine tElement_init + +end module element diff --git a/src/homogenization.f90 b/src/homogenization.f90 index ac41158a1..8edecbc88 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -71,11 +71,8 @@ subroutine homogenization_init debug_e, & debug_g use mesh, only: & - mesh_maxNips, & - mesh_NcpElems, & - mesh_element, & - FE_Nips, & - FE_geomtype + theMesh, & + mesh_element use constitutive, only: & constitutive_plasticity_maxSizePostResults, & constitutive_source_maxSizePostResults @@ -244,20 +241,20 @@ subroutine homogenization_init !-------------------------------------------------------------------------------------------------- ! allocate and initialize global variables - allocate(materialpoint_dPdF(3,3,3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_F0(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - materialpoint_F0 = spread(spread(math_I3,3,mesh_maxNips),4,mesh_NcpElems) ! initialize to identity - allocate(materialpoint_F(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + 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 + 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,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subF(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_P(3,3,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subFrac(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subStep(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_subdt(mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(materialpoint_requested(mesh_maxNips,mesh_NcpElems), source=.false.) - allocate(materialpoint_converged(mesh_maxNips,mesh_NcpElems), source=.true.) - allocate(materialpoint_doneAndHappy(2,mesh_maxNips,mesh_NcpElems), source=.true.) + allocate(materialpoint_subF0(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subF(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_P(3,3,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subFrac(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subStep(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_subdt(theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(materialpoint_requested(theMesh%elem%nIPs,theMesh%nElems), source=.false.) + allocate(materialpoint_converged(theMesh%elem%nIPs,theMesh%nElems), source=.true.) + allocate(materialpoint_doneAndHappy(2,theMesh%elem%nIPs,theMesh%nElems), source=.true.) !-------------------------------------------------------------------------------------------------- ! allocate and initialize global state and postresutls variables @@ -277,7 +274,7 @@ subroutine homogenization_init + homogenization_maxNgrains * (1 + crystallite_maxSizePostResults & ! crystallite size & crystallite results + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + constitutive_source_maxSizePostResults) - allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems)) + allocate(materialpoint_results(materialpoint_sizeResults,theMesh%elem%nIPs,theMesh%nElems)) write(6,'(/,a)') ' <<<+- homogenization init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -346,7 +343,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_Lp, & crystallite_Li0, & crystallite_Li, & - crystallite_dPdF, & crystallite_Tstar0_v, & crystallite_Tstar_v, & crystallite_partionedF0, & @@ -600,7 +596,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) IpLooping2: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) if ( materialpoint_requested(i,e) .and. & ! process requested but... .not. materialpoint_doneAndHappy(1,i,e)) then ! ...not yet done material points - call partitionDeformation(i,e) ! partition deformation onto constituents + call partitionDeformation(i,e) ! partition deformation onto constituents crystallite_dt(1:myNgrains,i,e) = materialpoint_subdt(i,e) ! propagate materialpoint dt to grains crystallite_requested(1:myNgrains,i,e) = .true. ! request calculation for constituents else @@ -614,7 +610,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) ! crystallite integration ! based on crystallite_partionedF0,.._partionedF ! incrementing by crystallite_dt - materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic + + materialpoint_converged = crystallite_stress() !ToDo: MD not sure if that is the best logic !-------------------------------------------------------------------------------------------------- ! state update diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 3d1de3d0a..3696593ad 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -24,10 +24,10 @@ module kinematics_thermal_expansion integer(pInt), dimension(:), allocatable, target, public :: & kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage -! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult -! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output -! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... -! end enum + enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult + enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output + thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... + end enum public :: & kinematics_thermal_expansion_init, & kinematics_thermal_expansion_initialStrain, & diff --git a/src/material.f90 b/src/material.f90 index 3ae6c16a4..4160c906e 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -305,9 +305,7 @@ subroutine material_init() texture_name use mesh, only: & mesh_homogenizationAt, & - mesh_NipsPerElem, & - mesh_NcpElems, & - FE_geomtype + theMesh implicit none integer(pInt), parameter :: FILEUNIT = 210_pInt @@ -399,10 +397,10 @@ subroutine material_init() call material_populateGrains ! BEGIN DEPRECATED - allocate(phaseAt ( homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt) - allocate(phasememberAt ( homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt) - allocate(mappingHomogenization (2, mesh_nIPsPerElem,mesh_NcpElems),source=0_pInt) - allocate(mappingHomogenizationConst( mesh_nIPsPerElem,mesh_NcpElems),source=1_pInt) + allocate(phaseAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) + allocate(phasememberAt ( homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) + allocate(mappingHomogenization (2, theMesh%elem%nIPs,theMesh%Nelems),source=0_pInt) + allocate(mappingHomogenizationConst( theMesh%elem%nIPs,theMesh%Nelems),source=1_pInt) ! END DEPRECATED allocate(material_homogenizationAt,source=mesh_homogenizationAt) @@ -410,9 +408,9 @@ subroutine material_init() allocate(CounterHomogenization(size(config_homogenization)),source=0_pInt) ! BEGIN DEPRECATED - do e = 1_pInt,mesh_NcpElems + do e = 1_pInt,theMesh%Nelems myHomog = mesh_homogenizationAt(e) - do i = 1_pInt, mesh_NipsPerElem + do i = 1_pInt, theMesh%elem%nIPs CounterHomogenization(myHomog) = CounterHomogenization(myHomog) + 1_pInt mappingHomogenization(1:2,i,e) = [CounterHomogenization(myHomog),myHomog] do g = 1_pInt,homogenization_Ngrains(myHomog) @@ -553,7 +551,7 @@ subroutine material_parseMicrostructure microstructure_name use mesh, only: & mesh_microstructureAt, & - mesh_NcpElems + theMesh implicit none character(len=65536), dimension(:), allocatable :: & @@ -571,7 +569,7 @@ subroutine material_parseMicrostructure if(any(mesh_microstructureAt > size(config_microstructure))) & call IO_error(155_pInt,ext_msg='More microstructures in geometry than sections in material.config') - forall (e = 1_pInt:mesh_NcpElems) & + forall (e = 1_pInt:theMesh%Nelems) & microstructure_active(mesh_microstructureAt(e)) = .true. ! current microstructure used in model? Elementwise view, maximum N operations for N elements do m=1_pInt, size(config_microstructure) @@ -984,13 +982,10 @@ subroutine material_populateGrains math_sampleFiberOri, & math_symmetricEulers use mesh, only: & - mesh_NipsPerElem, & - mesh_elemType, & mesh_homogenizationAt, & mesh_microstructureAt, & - mesh_NcpElems, & - mesh_ipVolume, & - FE_geomtype + theMesh, & + mesh_ipVolume use config, only: & config_homogenization, & config_microstructure, & @@ -1026,24 +1021,24 @@ subroutine material_populateGrains myDebug = debug_level(debug_material) - allocate(material_volume(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0.0_pReal) - allocate(material_phase(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt) - allocate(material_homog(mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt) - allocate(material_texture(homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems), source=0_pInt) - allocate(material_EulerAngles(3,homogenization_maxNgrains,mesh_nIPsPerElem,mesh_NcpElems),source=0.0_pReal) + allocate(material_volume(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0.0_pReal) + allocate(material_phase(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_homog(theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_texture(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems), source=0_pInt) + allocate(material_EulerAngles(3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%Nelems),source=0.0_pReal) allocate(Ngrains(size(config_homogenization),size(config_microstructure)), source=0_pInt) allocate(Nelems (size(config_homogenization),size(config_microstructure)), source=0_pInt) ! populating homogenization schemes in each !-------------------------------------------------------------------------------------------------- - do e = 1_pInt, mesh_NcpElems - material_homog(1_pInt:mesh_NipsPerElem,e) = mesh_homogenizationAt(e) + do e = 1_pInt, theMesh%Nelems + material_homog(1_pInt:theMesh%elem%nIPs,e) = mesh_homogenizationAt(e) enddo !-------------------------------------------------------------------------------------------------- ! precounting of elements for each homog/micro pair - do e = 1_pInt, mesh_NcpElems + do e = 1_pInt, theMesh%Nelems homog = mesh_homogenizationAt(e) micro = mesh_microstructureAt(e) Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt @@ -1061,8 +1056,7 @@ subroutine material_populateGrains !-------------------------------------------------------------------------------------------------- ! identify maximum grain count per IP (from element) and find grains per homog/micro pair Nelems = 0_pInt ! reuse as counter - elementLooping: do e = 1_pInt,mesh_NcpElems - t = mesh_elemType + elementLooping: do e = 1_pInt,theMesh%Nelems homog = mesh_homogenizationAt(e) micro = mesh_microstructureAt(e) if (homog < 1_pInt .or. homog > size(config_homogenization)) & ! out of bounds @@ -1072,7 +1066,7 @@ subroutine material_populateGrains if (microstructure_elemhomo(micro)) then ! how many grains are needed at this element? dGrains = homogenization_Ngrains(homog) ! only one set of Ngrains (other IPs are plain copies) else - dGrains = homogenization_Ngrains(homog) * mesh_NipsPerElem ! each IP has Ngrains + dGrains = homogenization_Ngrains(homog) * theMesh%elem%nIPs ! each IP has Ngrains endif Ngrains(homog,micro) = Ngrains(homog,micro) + dGrains ! total grain count Nelems(homog,micro) = Nelems(homog,micro) + 1_pInt ! total element count @@ -1106,16 +1100,15 @@ subroutine material_populateGrains do hme = 1_pInt, Nelems(homog,micro) e = elemsOfHomogMicro(homog,micro)%p(hme) ! my combination of homog and micro, only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex - t = mesh_elemType if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs - volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:mesh_NipsPerElem,e))/& + volumeOfGrain(grain+1_pInt:grain+dGrains) = sum(mesh_ipVolume(1:theMesh%elem%nIPs,e))/& real(dGrains,pReal) ! each grain combines size of all IPs in that element grain = grain + dGrains ! wind forward by Ngrains@IP else - forall (i = 1_pInt:mesh_NipsPerElem) & ! loop over IPs + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over IPs volumeOfGrain(grain+(i-1)*dGrains+1_pInt:grain+i*dGrains) = & mesh_ipVolume(i,e)/real(dGrains,pReal) ! assign IPvolume/Ngrains@IP to all grains of IP - grain = grain + mesh_NipsPerElem * dGrains ! wind forward by Nips*Ngrains@IP + grain = grain + theMesh%elem%nIPs * dGrains ! wind forward by Nips*Ngrains@IP endif enddo @@ -1261,11 +1254,10 @@ subroutine material_populateGrains do hme = 1_pInt, Nelems(homog,micro) e = elemsOfHomogMicro(homog,micro)%p(hme) ! only perform calculations for elements with homog, micro combinations which is indexed in cpElemsindex - t = mesh_elemType if (microstructure_elemhomo(micro)) then ! homogeneous distribution of grains over each element's IPs m = 1_pInt ! process only first IP else - m = mesh_NipsPerElem + m = theMesh%elem%nIPs endif do i = 1_pInt, m ! loop over necessary IPs @@ -1303,7 +1295,7 @@ subroutine material_populateGrains enddo - do i = i, mesh_NipsPerElem ! loop over IPs to (possibly) distribute copies from first IP + do i = i, theMesh%elem%nIPs ! loop over IPs to (possibly) distribute copies from first IP material_volume (1_pInt:dGrains,i,e) = material_volume (1_pInt:dGrains,1,e) material_phase (1_pInt:dGrains,i,e) = material_phase (1_pInt:dGrains,1,e) material_texture(1_pInt:dGrains,i,e) = material_texture(1_pInt:dGrains,1,e) diff --git a/src/meshFEM.f90 b/src/mesh_FEM.f90 similarity index 93% rename from src/meshFEM.f90 rename to src/mesh_FEM.f90 index 1362063f8..ed80cbcba 100644 --- a/src/meshFEM.f90 +++ b/src/mesh_FEM.f90 @@ -12,7 +12,7 @@ module mesh #include #include use prec, only: pReal, pInt - + use mesh_base use PETScdmplex use PETScdmda use PETScis @@ -27,7 +27,6 @@ use PETScis mesh_NcpElems, & !< total number of CP elements in mesh mesh_NcpElemsGlobal, & mesh_Nnodes, & !< total number of nodes in mesh - mesh_NipsPerElem, & !< number of IPs in per element mesh_maxNipNeighbors !!!! BEGIN DEPRECATED !!!!! integer(pInt), public, protected :: & @@ -79,7 +78,17 @@ use PETScis integer(pInt), dimension(1_pInt), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type int([6],pInt) + + type, public, extends(tMesh) :: tMesh_FEM + + contains + procedure, pass(self) :: tMesh_FEM_init + generic, public :: init => tMesh_FEM_init + end type tMesh_FEM + + type(tMesh_FEM), public, protected :: theMesh + public :: & mesh_init, & @@ -89,6 +98,25 @@ use PETScis contains +subroutine tMesh_FEM_init(self,dimen,order,nodes) + + implicit none + integer, intent(in) :: dimen + integer(pInt), intent(in) :: order + real(pReal), intent(in), dimension(:,:) :: nodes + class(tMesh_FEM) :: self + + if (dimen == 2_pInt) then + if (order == 1_pInt) call self%tMesh%init('mesh',1_pInt,nodes) + if (order == 2_pInt) call self%tMesh%init('mesh',2_pInt,nodes) + elseif(dimen == 3_pInt) then + if (order == 1_pInt) call self%tMesh%init('mesh',6_pInt,nodes) + if (order == 2_pInt) call self%tMesh%init('mesh',8_pInt,nodes) + endif + + end subroutine tMesh_FEM_init + + !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -213,6 +241,8 @@ subroutine mesh_init() FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) mesh_maxNips = FE_Nips(1_pInt) + + write(6,*) 'mesh_maxNips',mesh_maxNips call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p) call mesh_FEM_build_ipVolumes(dimPlex) @@ -238,12 +268,14 @@ subroutine mesh_init() !!!! COMPATIBILITY HACK !!!! ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - + allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) + call theMesh%init(dimplex,integrationOrder,mesh_node0) + call theMesh%setNelems(mesh_NcpElems) + end subroutine mesh_init diff --git a/src/mesh.f90 b/src/mesh_abaqus.f90 similarity index 65% rename from src/mesh.f90 rename to src/mesh_abaqus.f90 index e55165d51..4e923606e 100644 --- a/src/mesh.f90 +++ b/src/mesh_abaqus.f90 @@ -6,8 +6,8 @@ !> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver !-------------------------------------------------------------------------------------------------- module mesh - use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -17,8 +17,6 @@ module mesh mesh_Nnodes, & !< total number of nodes in mesh mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) mesh_Ncells, & !< total number of cells in mesh - mesh_NipsPerElem, & !< number of IPs in per element - mesh_NcellnodesPerElem, & !< number of cell nodes per element mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! @@ -32,7 +30,6 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_CPnodeID, & !< nodes forming an element mesh_element, & !DEPRECATED mesh_sharedElem, & !< entryCount and list of elements containing node mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) @@ -62,11 +59,9 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) -#if defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_maxNelemInSet, & mesh_Nmaterials -#endif integer(pInt), dimension(2), private :: & mesh_maxValStateVar = 0_pInt @@ -329,7 +324,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 6 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_maxNnodesAtIP = & !< maximum number of parent nodes that belong to an IP for a specific type of element int([ & 3, & ! element 6 (2D 3node 1ip) @@ -344,19 +338,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! element 21 (3D 20node 27ip) ],pInt) -#if defined(Spectral) - integer(pInt), dimension(3), public, protected :: & - grid !< (global) grid - integer(pInt), public, protected :: & - mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh - grid3, & !< (local) grid in 3rd direction - grid3Offset !< (local) grid offset in 3rd direction - real(pReal), dimension(3), public, protected :: & - geomSize - real(pReal), public, protected :: & - size3, & !< (local) size in 3rd direction - size3offset !< (local) size offset in 3rd direction -#elif defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), private :: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) mesh_maxNnodes, & !< max number of nodes in any CP element @@ -370,17 +351,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & integer(pInt), dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] -#endif -#if defined(Marc4DAMASK) - integer(pInt), private :: & - MarcVersion, & !< Version of input file format (Marc only) - hypoelasticTableStyle, & !< Table style (Marc only) - initialcondTableStyle !< Table style (Marc only) - integer(pInt), dimension(:), allocatable, private :: & - Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) -#elif defined(Abaqus) logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information -#endif public :: & mesh_init, & @@ -388,50 +359,17 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_ipVolumes, & mesh_build_ipCoordinates, & mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & -#if defined(Spectral) - mesh_spectral_getGrid, & - mesh_spectral_getSize -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_FEasCP -#endif private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_tell_statistics, & FE_mapElemtype, & - mesh_faceMatch, & mesh_build_FEdata, & -#if defined(Spectral) - mesh_spectral_getHomogenization, & - mesh_spectral_count, & - mesh_spectral_count_cpSizes, & - mesh_spectral_build_nodes, & - mesh_spectral_build_elements, & - mesh_spectral_build_ipNeighborhood -#elif defined(Marc4DAMASK) || defined(Abaqus) mesh_build_nodeTwins, & mesh_build_sharedElems, & mesh_build_ipNeighborhood, & -#endif -#if defined(Marc4DAMASK) - mesh_marc_get_fileFormat, & - mesh_marc_get_tableStyles, & - mesh_marc_get_matNumber, & - mesh_marc_count_nodesAndElements, & - mesh_marc_count_elementSets, & - mesh_marc_map_elementSets, & - mesh_marc_count_cpElements, & - mesh_marc_map_Elements, & - mesh_marc_map_nodes, & - mesh_marc_build_nodes, & - mesh_marc_count_cpSizes, & - mesh_marc_build_elements -#elif defined(Abaqus) mesh_abaqus_count_nodesAndElements, & mesh_abaqus_count_elementSets, & mesh_abaqus_count_materials, & @@ -443,36 +381,52 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_abaqus_build_nodes, & mesh_abaqus_count_cpSizes, & mesh_abaqus_build_elements -#endif + + type, public, extends(tMesh) :: tMesh_abaqus + + integer(pInt):: & + mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) + mesh_maxNnodes, & !< max number of nodes in any CP element + mesh_NelemSets, & + mesh_maxNelemInSet, & + mesh_Nmaterials + character(len=64), dimension(:), allocatable :: & + mesh_nameElemSet, & !< names of elementSet + mesh_nameMaterial, & !< names of material in solid section + mesh_mapMaterial !< name of elementSet for material + integer(pInt), dimension(:,:), allocatable :: & + mesh_mapElemSet !< list of elements in elementSet + logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information + + contains + procedure, pass(self) :: tMesh_abaqus_init + generic, public :: init => tMesh_abaqus_init + end type tMesh_abaqus + + type(tMesh_abaqus), public, protected :: theMesh + contains +subroutine tMesh_abaqus_init(self,elemType,nodes) + + implicit none + class(tMesh_abaqus) :: self + real(pReal), dimension(:,:), intent(in) :: nodes + integer(pInt), intent(in) :: elemType + + call self%tMesh%init('mesh',elemType,nodes) + +end subroutine tMesh_abaqus_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module !! Order and routines strongly depend on type of solver !-------------------------------------------------------------------------------------------------- subroutine mesh_init(ip,el) -#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif -#ifdef Spectral -#include - use PETScsys -#endif use DAMASK_interface use IO, only: & -#ifdef Abaqus - IO_abaqus_hasNoPart, & -#endif -#ifdef Spectral - IO_open_file, & - IO_error, & -#else IO_open_InputFile, & -#endif IO_timeStamp, & IO_error, & IO_write_jobFile @@ -487,95 +441,25 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral modelName, & - calcMode, & -#endif - FEsolving_execElem, & + calcMode, & FEsolving_execElem, & FEsolving_execIP implicit none -#ifdef Spectral - include 'fftw3-mpi.f03' - integer(C_INTPTR_T) :: devNull, local_K, local_K_offset - integer :: ierr, worldsize -#endif integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) -#ifdef Spectral - call fftw_mpi_init() - call IO_open_file(FILEUNIT,geometryFile) ! parse info from geometry file... - if (myDebug) write(6,'(a)') ' Opened geometry file'; flush(6) - grid = mesh_spectral_getGrid(fileUnit) - call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) - if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') - if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') - - geomSize = mesh_spectral_getSize(fileUnit) - devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & - int(grid(2),C_INTPTR_T), & - int(grid(1),C_INTPTR_T)/2+1, & - PETSC_COMM_WORLD, & - local_K, & ! domain grid size along z - local_K_offset) ! domain grid offset along z - grid3 = int(local_K,pInt) - grid3Offset = int(local_K_offset,pInt) - size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) - size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) - if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) - call mesh_spectral_count() - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_spectral_count_cpSizes - if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) - call mesh_spectral_build_nodes() - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_spectral_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Marc4DAMASK call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - call mesh_marc_get_fileFormat(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) - call mesh_marc_get_tableStyles(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) - if (MarcVersion > 12) then - call mesh_marc_get_matNumber(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) - endif - call mesh_marc_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_marc_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_marc_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_marc_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_marc_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_marc_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_marc_count_cpSizes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) - call mesh_marc_build_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#elif defined Abaqus - call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... - if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) - noPart = IO_abaqus_hasNoPart(FILEUNIT) + noPart = hasNoPart(FILEUNIT) call mesh_abaqus_count_nodesAndElements(FILEUNIT) if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) call mesh_abaqus_count_elementSets(FILEUNIT) @@ -598,10 +482,14 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) call mesh_abaqus_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) -#endif - - call mesh_get_damaskOptions(FILEUNIT) + call mesh_get_damaskOptions(mesh_periodicSurface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + close (FILEUNIT) + + call theMesh%init(mesh_element(2,1),mesh_node0) + call theMesh%setNelems(mesh_NcpElems) + call mesh_build_FEdata ! get properties of the different types of elements + call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -612,106 +500,807 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) call mesh_build_ipAreas if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) - close (FILEUNIT) - -#if defined(Marc4DAMASK) || defined(Abaqus) call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) call mesh_build_ipNeighborhood -#else - call mesh_spectral_build_ipNeighborhood -#endif if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (worldrank == 0_pInt) then - call mesh_tell_statistics - endif - -#if defined(Marc4DAMASK) || defined(Abaqus) if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements -#endif if (debug_e < 1 .or. debug_e > mesh_NcpElems) & call IO_error(602_pInt,ext_msg='element') ! selected element does not exist if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP - FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements allocate(FEsolving_execIP(2_pInt,mesh_NcpElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element - -#if defined(Marc4DAMASK) || defined(Abaqus) allocate(calcMode(mesh_maxNips,mesh_NcpElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" -#endif -!!!! COMPATIBILITY HACK !!!! -! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. -! hence, xxPerElem instead of maxXX - mesh_NipsPerElem = mesh_maxNips - mesh_NcellnodesPerElem = mesh_maxNcellnodes + ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) - mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) -!!!!!!!!!!!!!!!!!!!!!!!! + + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief check if the input file for Abaqus contains part info +!-------------------------------------------------------------------------------------------------- +logical function hasNoPart(fileUnit) + use IO, only: & + IO_stringPos, & + IO_stringValue, & + IO_lc + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line + + hasNoPart = .true. + + rewind(fileUnit) + do + read(fileUnit,'(a65536)',END=620) line + chunkPos = IO_stringPos(line) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then + hasNoPart = .false. + exit + endif + enddo + +620 end function hasNoPart end subroutine mesh_init -#if defined(Marc4DAMASK) || defined(Abaqus) + + + + + + !-------------------------------------------------------------------------------------------------- -!> @brief Gives the FE to CP ID mapping by binary search through lookup array -!! valid questions (what) are 'elem', 'node' +!> @brief Count overall number of nodes and elements in mesh and stores them in +!! 'mesh_Nelems' and 'mesh_Nnodes' !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) - use IO, only: & - IO_lc +subroutine mesh_abaqus_count_nodesAndElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_error implicit none - character(len=*), intent(in) :: what - integer(pInt), intent(in) :: myID + integer(pInt), intent(in) :: fileUnit - integer(pInt), dimension(:,:), pointer :: lookupMap - integer(pInt) :: lower,upper,center + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart - mesh_FEasCP = 0_pInt - select case(IO_lc(what(1:4))) - case('elem') - lookupMap => mesh_mapFEtoCPelem - case('node') - lookupMap => mesh_mapFEtoCPnode - case default - return - endselect + mesh_Nnodes = 0_pInt + mesh_Nelems = 0_pInt + + inPart = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - lower = 1_pInt - upper = int(size(lookupMap,2_pInt),pInt) - - if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? - mesh_FEasCP = lookupMap(2_pInt,lower) - return - elseif (lookupMap(1_pInt,upper) == myID) then - mesh_FEasCP = lookupMap(2_pInt,upper) - return - endif - binarySearch: do while (upper-lower > 1_pInt) - center = (lower+upper)/2_pInt - if (lookupMap(1_pInt,center) < myID) then - lower = center - elseif (lookupMap(1_pInt,center) > myID) then - upper = center - else - mesh_FEasCP = lookupMap(2_pInt,center) - exit + if (inPart .or. noPart) then + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) + case('*node') + if( & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + ) & + mesh_Nnodes = mesh_Nnodes + IO_countDataLines(fileUnit) + case('*element') + if( & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & + ) then + mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) + endif + endselect endif - enddo binarySearch + enddo + + if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) + if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) + +end subroutine mesh_abaqus_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and +!! 'mesh_maxNelemInSet' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart + + mesh_NelemSets = 0_pInt + mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons + + inPart = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & + mesh_NelemSets = mesh_NelemSets + 1_pInt + enddo + + if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) + +end subroutine mesh_abaqus_count_elementSets + + +!-------------------------------------------------------------------------------------------------- +! count overall number of solid sections sets in mesh (Abaqus only) +! +! mesh_Nmaterials +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart + + mesh_Nmaterials = 0_pInt + + inPart = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. & + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) & + mesh_Nmaterials = mesh_Nmaterials + 1_pInt + enddo + + if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + +end subroutine mesh_abaqus_count_materials + + +!-------------------------------------------------------------------------------------------------- +! Build element set mapping +! +! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elementSets(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart + integer(pInt) :: elemSet,i + + allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' + allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + + + elemSet = 0_pInt + inPart = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then + elemSet = elemSet + 1_pInt + mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) + mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& + mesh_mapElemSet,elemSet-1_pInt) + endif + enddo + + do i = 1_pInt,elemSet + if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) + enddo + +end subroutine mesh_abaqus_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +! map solid section (Abaqus only) +! +! allocate globals: mesh_nameMaterial, mesh_mapMaterial +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_materials(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart + integer(pInt) :: i,c + character(len=64) :: elemSetName,materialName + + allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' + allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' + + c = 0_pInt + inPart = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if ( (inPart .or. noPart) .and. & + IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then + + elemSetName = '' + materialName = '' + + do i = 3_pInt,chunkPos(1_pInt) + if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset') /= '') & + elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset')) + if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material') /= '') & + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) + enddo + + if (elemSetName /= '' .and. materialName /= '') then + c = c + 1_pInt + mesh_nameMaterial(c) = materialName ! name of material used for this section + mesh_mapMaterial(c) = elemSetName ! mapped to respective element set + endif + endif + enddo + + if (c==0_pInt) call IO_error(error_ID=905_pInt) + do i=1_pInt,c + if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905_pInt) + enddo + + end subroutine mesh_abaqus_map_materials + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpElements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_error, & + IO_extractValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: materialFound + integer(pInt) :: i,k + character(len=64) ::materialName,elemSetName + + mesh_NcpElems = 0_pInt + materialFound = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if (IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then + do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (materialName == mesh_nameMaterial(i)) then ! found one + elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet + do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + if (elemSetName == mesh_nameElemSet(k)) & ! matched? + mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + + if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + +end subroutine mesh_abaqus_count_cpElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPelem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_elements(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: materialFound + integer(pInt) ::i,j,k,cpElem + character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + + cpElem = 0_pInt + materialFound = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then + do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (materialName == mesh_nameMaterial(i)) then ! found one + elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet + do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + if (elemSetName == mesh_nameElemSet(k)) then ! matched? + do j = 1_pInt,mesh_mapElemSet(1,k) + cpElem = cpElem + 1_pInt + mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1_pInt+j,k) ! store FE id + mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + + call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + + if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) + +end subroutine mesh_abaqus_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!! Allocates global array 'mesh_mapFEtoCPnode' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_map_nodes(fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countDataLines, & + IO_intValue, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart + integer(pInt) :: i,c,cpNode + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) + + cpNode = 0_pInt + inPart = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,'(a300)') line + chunkPos = IO_stringPos(line) + cpNode = cpNode + 1_pInt + mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) + mesh_mapFEtoCPnode(2_pInt,cpNode) = cpNode + enddo + endif + enddo + + call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + + if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) + +end subroutine mesh_abaqus_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_nodes(fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_floatValue, & + IO_stringPos, & + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart + integer(pInt) :: i,j,m,c + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) + + inPart = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + c = IO_countDataLines(fileUnit) ! how many nodes are defined here? + do i = 1_pInt,c + backspace(fileUnit) ! rewind to first entry + enddo + do i = 1_pInt,c + read (fileUnit,'(a300)') line + chunkPos = IO_stringPos(line) + m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) + do j=1_pInt, 3_pInt + mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) + enddo + enddo + endif + enddo + + if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + mesh_node = mesh_node0 + +end subroutine mesh_abaqus_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_extractValue ,& + IO_error, & + IO_countDataLines, & + IO_intValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart + integer(pInt) :: i,c,t,g + + mesh_maxNnodes = 0_pInt + mesh_maxNips = 0_pInt + mesh_maxNipNeighbors = 0_pInt + mesh_maxNcellnodes = 0_pInt + + + inPart = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + g = FE_geomtype(t) + c = FE_celltype(g) + mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) + mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) + mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) + mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) + endif + enddo + +end subroutine mesh_abaqus_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per elemen. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_abaqus_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_intValue, & + IO_extractValue, & + IO_floatValue, & + IO_countDataLines, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart, materialFound + integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead + character (len=64) :: materialName,elemSetName + + allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + mesh_elemType = -1_pInt + + inPart = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. + + if( (inPart .or. noPart) .and. & + IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & + ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & + IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & + ) then + t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type + c = IO_countDataLines(fileUnit) + do i = 1_pInt,c + backspace(fileUnit) + enddo + do i = 1_pInt,c + read (fileUnit,'(a300)') line + chunkPos = IO_stringPos(line) ! limit to 64 nodes max + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then ! disregard non CP elems + mesh_element(1,e) = -1_pInt ! DEPRECATED + if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + call IO_error(191,el=t,ip=mesh_elemType) + mesh_elemType = t + mesh_element(2,e) = t ! elem type + nNodesAlreadyRead = 0_pInt + do j = 1_pInt,chunkPos(1)-1_pInt + mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt+j)) ! put CP ids of nodes to position 5: + enddo + nNodesAlreadyRead = chunkPos(1) - 1_pInt + do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line + read (fileUnit,'(a300)') line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + endif + enddo + + + rewind(fileUnit) ! just in case "*material" definitions apear before "*element" + + materialFound = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) + case('*material') + materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value + materialFound = materialName /= '' ! valid name? + case('*user') + if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & + materialFound ) then + read (fileUnit,'(a300)') line ! read homogenization and microstructure + chunkPos = IO_stringPos(line) + homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) + micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) + do i = 1_pInt,mesh_Nmaterials ! look thru material names + if (materialName == mesh_nameMaterial(i)) then ! found one + elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet + do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions + if (elemSetName == mesh_nameElemSet(k)) then ! matched? + do j = 1_pInt,mesh_mapElemSet(1,k) + e = mesh_FEasCP('elem',mesh_mapElemSet(1+j,k)) + mesh_element(3,e) = homog ! store homogenization + mesh_element(4,e) = micro ! store microstructure + mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) + enddo + endif + enddo + endif + enddo + materialFound = .false. + endif + endselect + enddo + +end subroutine mesh_abaqus_build_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief get any additional damask options from input file, sets mesh_periodicSurface +!-------------------------------------------------------------------------------------------------- +subroutine mesh_get_damaskOptions(periodic_surface,fileUnit) + +use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + integer(pInt) :: chunk, Nchunks + character(len=300) :: v + logical, dimension(3) :: periodic_surface + + + periodic_surface = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + Nchunks = chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '**damask' .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case('periodic') ! damask Option that allows to specify periodic fluxes + do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) + v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? + mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' + mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' + mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' + enddo + endselect + endif + enddo + +end subroutine mesh_get_damaskOptions -end function mesh_FEasCP -#endif !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -837,10 +1426,7 @@ subroutine mesh_build_ipVolumes integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - if (.not. allocated(mesh_ipVolume)) then - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal - endif + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) do e = 1_pInt,mesh_NcpElems ! loop over cpElems @@ -953,1903 +1539,8 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -#ifdef Spectral -!-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getGrid(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - implicit none - integer(pInt), dimension(3) :: mesh_spectral_getGrid - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotGrid = .false. - - mesh_spectral_getGrid = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getGrid') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) - case ('grid') - gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - mesh_spectral_getGrid(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - mesh_spectral_getGrid(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - mesh_spectral_getGrid(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotGrid) & - call IO_error(error_ID = 845_pInt, ext_msg='grid') - if(any(mesh_spectral_getGrid < 1_pInt)) & - call IO_error(error_ID = 843_pInt, ext_msg='mesh_spectral_getGrid') - -end function mesh_spectral_getGrid - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -function mesh_spectral_getSize(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_floatValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - real(pReal), dimension(3) :: mesh_spectral_getSize - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotSize = .false. - - mesh_spectral_getSize = -1.0_pReal - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getSize') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('size') - gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - mesh_spectral_getSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - mesh_spectral_getSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - mesh_spectral_getSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotSize) & - call IO_error(error_ID = 845_pInt, ext_msg='size') - if (any(mesh_spectral_getSize<=0.0_pReal)) & - call IO_error(error_ID = 844_pInt, ext_msg='mesh_spectral_getSize') - -end function mesh_spectral_getSize - - -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_open_file, & - IO_stringPos, & - IO_lc, & - IO_stringValue, & - IO_intValue, & - IO_error - use DAMASK_interface, only: & - geometryFile - - implicit none - integer(pInt), intent(in), optional :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, myFileUnit - logical :: gotHomogenization = .false. - - mesh_spectral_getHomogenization = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif - - call IO_checkAndRewind(myFileUnit) - - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_getHomogenization') - endif - rewind(myFileUnit) - do i = 1_pInt, headerLength - read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) - case ('homogenization') - gotHomogenization = .true. - mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) - end select - enddo - - if(.not. present(fileUnit)) close(myFileUnit) - - if (.not. gotHomogenization ) & - call IO_error(error_ID = 845_pInt, ext_msg='homogenization') - if (mesh_spectral_getHomogenization<1_pInt) & - call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - -end function mesh_spectral_getHomogenization - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count() - - implicit none - - mesh_NcpElems= product(grid(1:2))*grid3 - mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) - - mesh_NcpElemsGlobal = product(grid) - -end subroutine mesh_spectral_count - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_count_cpSizes - - implicit none - integer(pInt) :: t,g,c - - t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element - g = FE_geomtype(t) - c = FE_celltype(g) - - mesh_maxNips = FE_Nips(g) - mesh_maxNipNeighbors = FE_NipNeighbors(c) - mesh_maxNcellnodes = FE_Ncellnodes(g) - -end subroutine mesh_spectral_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_nodes() - - implicit none - integer(pInt) :: n - - allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) - allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) - - forall (n = 0_pInt:mesh_Nnodes-1_pInt) - mesh_node0(1,n+1_pInt) = mesh_unitlength * & - geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & - / real(grid(1),pReal) - mesh_node0(2,n+1_pInt) = mesh_unitlength * & - geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & - / real(grid(2),pReal) - mesh_node0(3,n+1_pInt) = mesh_unitlength * & - size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & - / real(grid3,pReal) + & - size3offset - end forall - - mesh_node = mesh_node0 - -end subroutine mesh_spectral_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, material, texture, and node list per element. -!! Allocates global array 'mesh_element' -!> @todo does the IO_error makes sense? -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_elements(fileUnit) - use IO, only: & - IO_checkAndRewind, & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_continuousIntValues, & - IO_intValue, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: & - fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - e, i, & - headerLength = 0_pInt, & - maxDataPerLine, & - homog, & - elemType, & - elemOffset - integer(pInt), dimension(:), allocatable :: & - microstructures, & - microGlobal - integer(pInt), dimension(1,1) :: & - dummySet = 0_pInt - character(len=65536) :: & - line, & - keyword - character(len=64), dimension(1) :: & - dummyName = '' - - homog = mesh_spectral_getHomogenization(fileUnit) - -!-------------------------------------------------------------------------------------------------- -! get header length - call IO_checkAndRewind(fileUnit) - read(fileUnit,'(a65536)') line - chunkPos = IO_stringPos(line) - keyword = IO_lc(IO_StringValue(line,chunkPos,2_pInt,.true.)) - if (keyword(1:4) == 'head') then - headerLength = IO_intValue(line,chunkPos,1_pInt) + 1_pInt - else - call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') - endif - -!-------------------------------------------------------------------------------------------------- -! get maximum microstructure index - call IO_checkAndRewind(fileUnit) - do i = 1_pInt, headerLength - read(fileUnit,'(a65536)') line - enddo - - maxDataPerLine = 0_pInt - i = 1_pInt - - do while (i > 0_pInt) - i = IO_countContinuousIntValues(fileUnit) - maxDataPerLine = max(maxDataPerLine, i) ! found a longer line? - enddo - allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) - allocate(microstructures (1_pInt+maxDataPerLine), source = 1_pInt) ! prepare to receive counter and max data size - allocate(microGlobal (mesh_NcpElemsGlobal), source = 1_pInt) - -!-------------------------------------------------------------------------------------------------- -! read in microstructures - call IO_checkAndRewind(fileUnit) - do i=1_pInt,headerLength - read(fileUnit,'(a65536)') line - enddo - - e = 0_pInt - do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) - microstructures = IO_continuousIntValues(fileUnit,maxDataPerLine,dummyName,dummySet,0_pInt) ! get affected elements - do i = 1_pInt,microstructures(1_pInt) - e = e+1_pInt ! valid element entry - microGlobal(e) = microstructures(1_pInt+i) - enddo - enddo - - elemType = FE_mapElemtype('C3D8R') - elemOffset = product(grid(1:2))*grid3Offset - e = 0_pInt - do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) - e = e+1_pInt ! valid element entry - mesh_element( 1,e) = -1_pInt ! DEPRECATED - mesh_element( 2,e) = elemType ! elem type - mesh_element( 3,e) = homog ! homogenization - mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure - mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & - ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node - mesh_element( 6,e) = mesh_element(5,e) + 1_pInt - mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt - mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt - mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node - mesh_element(10,e) = mesh_element(9,e) + 1_pInt - mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt - mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) - enddo - - if (e /= mesh_NcpElems) call IO_error(880_pInt,e) - -end subroutine mesh_spectral_build_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief build neighborhood relations for spectral -!> @details assign globals: mesh_ipNeighborhood -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_ipNeighborhood - - implicit none - integer(pInt) :: & - x,y,z, & - e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) - - e = 0_pInt - do z = 0_pInt,grid3-1_pInt - do y = 0_pInt,grid(2)-1_pInt - do x = 0_pInt,grid(1)-1_pInt - e = e + 1_pInt - mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x+1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & - + y * grid(1) & - + modulo(x-1_pInt,grid(1)) & - + 1_pInt - mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & - + modulo(y+1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & - + modulo(y-1_pInt,grid(2)) * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & - + y * grid(1) & - + x & - + 1_pInt - mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt - mesh_ipNeighborhood(3,1,1,e) = 2_pInt - mesh_ipNeighborhood(3,2,1,e) = 1_pInt - mesh_ipNeighborhood(3,3,1,e) = 4_pInt - mesh_ipNeighborhood(3,4,1,e) = 3_pInt - mesh_ipNeighborhood(3,5,1,e) = 6_pInt - mesh_ipNeighborhood(3,6,1,e) = 5_pInt - enddo - enddo - enddo - -end subroutine mesh_spectral_build_ipNeighborhood - - -!-------------------------------------------------------------------------------------------------- -!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) -!-------------------------------------------------------------------------------------------------- -function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) - use debug, only: & - debug_mesh, & - debug_level, & - debug_levelBasic - use math, only: & - math_mul33x3 - - implicit none - real(pReal), intent(in), dimension(:,:,:,:) :: & - centres - real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & - nodes - real(pReal), intent(in), dimension(3) :: & - gDim - real(pReal), intent(in), dimension(3,3) :: & - Favg - real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & - wrappedCentres - - integer(pInt) :: & - i,j,k,n - integer(pInt), dimension(3), parameter :: & - diag = 1_pInt - integer(pInt), dimension(3) :: & - shift = 0_pInt, & - lookup = 0_pInt, & - me = 0_pInt, & - iRes = 0_pInt - integer(pInt), dimension(3,8) :: & - neighbor = reshape([ & - 0_pInt, 0_pInt, 0_pInt, & - 1_pInt, 0_pInt, 0_pInt, & - 1_pInt, 1_pInt, 0_pInt, & - 0_pInt, 1_pInt, 0_pInt, & - 0_pInt, 0_pInt, 1_pInt, & - 1_pInt, 0_pInt, 1_pInt, & - 1_pInt, 1_pInt, 1_pInt, & - 0_pInt, 1_pInt, 1_pInt ], [3,8]) - -!-------------------------------------------------------------------------------------------------- -! initializing variables - iRes = [size(centres,2),size(centres,3),size(centres,4)] - nodes = 0.0_pReal - wrappedCentres = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! report - if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then - write(6,'(a)') ' Meshing cubes around centroids' - write(6,'(a,3(e12.5))') ' Dimension: ', gDim - write(6,'(a,3(i5))') ' Resolution:', iRes - endif - -!-------------------------------------------------------------------------------------------------- -! building wrappedCentres = centroids + ghosts - wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres - do k = 0_pInt,iRes(3)+1_pInt - do j = 0_pInt,iRes(2)+1_pInt - do i = 0_pInt,iRes(1)+1_pInt - if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin - j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin - i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin - me = [i,j,k] ! me on skin - shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) - lookup = me-diag+shift*iRes - wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & - centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & - - math_mul33x3(Favg, real(shift,pReal)*gDim) - endif - enddo; enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! averaging - do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) - do n = 1_pInt,8_pInt - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & - nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & - j+1_pInt+neighbor(2,n), & - k+1_pInt+neighbor(3,n) ) - enddo - enddo; enddo; enddo - nodes = nodes/8.0_pReal - -end function mesh_nodesAroundCentres -#endif - -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_fileFormat - - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then - initialcondTableStyle = IO_intValue(line,chunkPos,4_pInt) - hypoelasticTableStyle = IO_intValue(line,chunkPos,5_pInt) - exit - endif - enddo - -620 end subroutine mesh_marc_get_tableStyles - -!-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) - use IO, only: & - IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, j, data_blocks - character(len=300) line - -610 FORMAT(A300) - - rewind(fileUnit) - - data_blocks = 1_pInt - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - read (fileUnit,610,END=620) line - if (len(trim(line))/=0_pInt) then - chunkPos = IO_stringPos(line) - data_blocks = IO_intValue(line,chunkPos,1_pInt) - endif - allocate(Marc_matNumber(data_blocks)) - do i=1_pInt,data_blocks ! read all data blocks - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) - do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block - read (fileUnit,610,END=620) line - enddo - enddo - exit - endif - enddo - -620 end subroutine mesh_marc_get_matNumber - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_nodesAndElements(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_IntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file - endif - enddo - -620 end subroutine mesh_marc_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - - if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then - mesh_NelemSets = mesh_NelemSets + 1_pInt - mesh_maxNelemInSet = max(mesh_maxNelemInSet, & - IO_countContinuousIntValues(fileUnit)) - endif - enddo - -620 end subroutine mesh_marc_count_elementSets - - -!******************************************************************** -! map element sets -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!******************************************************************** -subroutine mesh_marc_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=640) line - chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then - elemSet = elemSet+1_pInt - mesh_nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) - mesh_mapElemSet(:,elemSet) = & - IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - endif - enddo - -640 end subroutine mesh_marc_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countContinuousIntValues, & - IO_error, & - IO_intValue, & - IO_countNumericalDataLines - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,610,END=620) line - enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update - exit - endif - enddo - else ! Marc2017 and later - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end subroutine mesh_marc_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_intValue, & - IO_stringValue, & - IO_stringPos, & - IO_continuousIntValues - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line, & - tmp - - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - contInts = 0_pInt - rewind(fileUnit) - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - if (MarcVersion < 13) then ! Marc 2016 or earlier - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines - read (fileUnit,610,END=660) line - enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) - exit - endif - else ! Marc2017 and later - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) - if (verify(trim(tmp),"0123456789")/=0) then ! found keyword - exit - else - contInts(1) = contInts(1) + 1_pInt - read (tmp,*) contInts(contInts(1)+1) - endif - enddo - endif - endif - endif - enddo -660 do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) - mesh_mapFEtoCPelem(2,cpElem) = cpElem - enddo - -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - -end subroutine mesh_marc_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension (mesh_Nnodes) :: node_count - integer(pInt) :: i - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - -610 FORMAT(A300) - - node_count = 0_pInt - - rewind(fileUnit) - do - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=650) line ! skip crap line - do i = 1_pInt,mesh_Nnodes - read (fileUnit,610,END=650) line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) - mesh_mapFEtoCPnode(2_pInt,i) = i - enddo - exit - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - -end subroutine mesh_marc_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_nodes(fileUnit) - - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_fixedIntValue, & - IO_fixedNoEFloatValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then - read (fileUnit,610,END=670) line ! skip crap line - do i=1_pInt,mesh_Nnodes - read (fileUnit,610,END=670) line - m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) - do j = 1_pInt,3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) - enddo - enddo - exit - endif - enddo - -670 mesh_node = mesh_node0 - -end subroutine mesh_marc_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_intValue, & - IO_skipChunks - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,t,g,e,c - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - rewind(fileUnit) - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=630) line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) ! limit to id and type - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line - endif - enddo - exit - endif - enddo - -630 end subroutine mesh_marc_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per element. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_fixedNoEFloatValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then - read (fileUnit,610,END=620) line ! garbage line - do i = 1_pInt,mesh_Nelems - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & - call IO_error(191,el=t,ip=mesh_elemType) - mesh_elemType = t - mesh_element(2,e) = t - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-2_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes - enddo - nNodesAlreadyRead = chunkPos(1) - 2_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - exit - endif - enddo - -620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,610,END=620) line - do - chunkPos = IO_stringPos(line) - if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & - (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then - if (initialcondTableStyle == 2_pInt) read (fileUnit,610,END=620) line ! read extra line for new style - read (fileUnit,610,END=630) line ! read line with index of state var - chunkPos = IO_stringPos(line) - sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index - if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest - read (fileUnit,610,END=620) line ! read line with value of state var - chunkPos = IO_stringPos(line) - do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? - myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value - mesh_maxValStateVar(sv-1_pInt) = max(myVal,mesh_maxValStateVar(sv-1_pInt)) ! remember max val of homogenization and microstructure index - if (initialcondTableStyle == 2_pInt) then - read (fileUnit,610,END=630) line ! read extra line - read (fileUnit,610,END=630) line ! read extra line - endif - contInts = IO_continuousIntValues& ! get affected elements - (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) - do i = 1_pInt,contInts(1) - e = mesh_FEasCP('elem',contInts(1_pInt+i)) - mesh_element(1_pInt+sv,e) = myVal - enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,610,END=620) line ! ignore IP range for old table style - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - enddo - endif - else - read (fileUnit,610,END=630) line - endif - enddo - -630 end subroutine mesh_marc_build_elements -#endif - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores them in -!! 'mesh_Nelems' and 'mesh_Nnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_nodesAndElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if (inPart .or. noPart) then - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) - case('*node') - if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & - ) & - mesh_Nnodes = mesh_Nnodes + IO_countDataLines(fileUnit) - case('*element') - if( & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' & - ) then - mesh_Nelems = mesh_Nelems + IO_countDataLines(fileUnit) - endif - endselect - endif - enddo - -620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) - if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) - -end subroutine mesh_abaqus_count_nodesAndElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief count overall number of element sets in mesh and write 'mesh_NelemSets' and -!! 'mesh_maxNelemInSet' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical :: inPart - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & - mesh_NelemSets = mesh_NelemSets + 1_pInt - enddo - -620 continue - if (mesh_NelemSets == 0) call IO_error(error_ID=902_pInt) - -end subroutine mesh_abaqus_count_elementSets - - -!-------------------------------------------------------------------------------------------------- -! count overall number of solid sections sets in mesh (Abaqus only) -! -! mesh_Nmaterials -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - logical inPart - - mesh_Nmaterials = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) & - mesh_Nmaterials = mesh_Nmaterials + 1_pInt - enddo - -620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) - -end subroutine mesh_abaqus_count_materials - - -!-------------------------------------------------------------------------------------------------- -! Build element set mapping -! -! allocate globals: mesh_nameElemSet, mesh_mapElemSet -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elementSets(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_continuousIntValues, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt,i - logical :: inPart = .false. - - allocate (mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = '' - allocate (mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) - -610 FORMAT(A300) - - - rewind(fileUnit) - do - read (fileUnit,610,END=640) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then - elemSet = elemSet + 1_pInt - mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) - mesh_mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,mesh_Nelems,mesh_nameElemSet,& - mesh_mapElemSet,elemSet-1_pInt) - endif - enddo - -640 do i = 1_pInt,elemSet - if (mesh_mapElemSet(1,i) == 0_pInt) call IO_error(error_ID=904_pInt,ext_msg=mesh_nameElemSet(i)) - enddo - -end subroutine mesh_abaqus_map_elementSets - - -!-------------------------------------------------------------------------------------------------- -! map solid section (Abaqus only) -! -! allocate globals: mesh_nameMaterial, mesh_mapMaterial -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_materials(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c = 0_pInt - logical :: inPart = .false. - character(len=64) :: elemSetName,materialName - - allocate (mesh_nameMaterial(mesh_Nmaterials)); mesh_nameMaterial = '' - allocate (mesh_mapMaterial(mesh_Nmaterials)); mesh_mapMaterial = '' - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if ( (inPart .or. noPart) .and. & - IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == '*solid' .and. & - IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'section' ) then - - elemSetName = '' - materialName = '' - - do i = 3_pInt,chunkPos(1_pInt) - if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset') /= '') & - elemSetName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'elset')) - if (IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material') /= '') & - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,i)),'material')) - enddo - - if (elemSetName /= '' .and. materialName /= '') then - c = c + 1_pInt - mesh_nameMaterial(c) = materialName ! name of material used for this section - mesh_mapMaterial(c) = elemSetName ! mapped to respective element set - endif - endif - enddo - -620 if (c==0_pInt) call IO_error(error_ID=905_pInt) - do i=1_pInt,c - if (mesh_nameMaterial(i)=='' .or. mesh_mapMaterial(i)=='') call IO_error(error_ID=905_pInt) - enddo - - end subroutine mesh_abaqus_map_materials - - -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpElements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_extractValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - integer(pInt) :: i,k - logical :: materialFound = .false. - character(len=64) ::materialName,elemSetName - - mesh_NcpElems = 0_pInt - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if (IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names - if (materialName == mesh_nameMaterial(i)) then ! found one - elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions - if (elemSetName == mesh_nameElemSet(k)) & ! matched? - mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet(1,k) ! add those elem count - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) - -end subroutine mesh_abaqus_count_cpElements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps elements from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_elements(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) ::i,j,k,cpElem = 0_pInt - logical :: materialFound = .false. - character (len=64) materialName,elemSetName ! why limited to 64? ABAQUS? - - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=660) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'material' .and. materialFound) then - do i = 1_pInt,mesh_Nmaterials ! look thru material names - if (materialName == mesh_nameMaterial(i)) then ! found one - elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions - if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) - cpElem = cpElem + 1_pInt - mesh_mapFEtoCPelem(1,cpElem) = mesh_mapElemSet(1_pInt+j,k) ! store FE id - mesh_mapFEtoCPelem(2,cpElem) = cpElem ! store our id - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems - - if (int(size(mesh_mapFEtoCPelem),pInt) < 2_pInt) call IO_error(error_ID=907_pInt) - -end subroutine mesh_abaqus_map_elements - - -!-------------------------------------------------------------------------------------------------- -!> @brief Maps node from FE ID to internal (consecutive) representation. -!! Allocates global array 'mesh_mapFEtoCPnode' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_map_nodes(fileUnit) - - use math, only: math_qsort - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_countDataLines, & - IO_intValue, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c,cpNode = 0_pInt - logical :: inPart = .false. - - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) - -610 FORMAT(A300) - - rewind(fileUnit) - do - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=650) line - chunkPos = IO_stringPos(line) - cpNode = cpNode + 1_pInt - mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) - mesh_mapFEtoCPnode(2_pInt,cpNode) = cpNode - enddo - endif - enddo - -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - - if (int(size(mesh_mapFEtoCPnode),pInt) == 0_pInt) call IO_error(error_ID=908_pInt) - -end subroutine mesh_abaqus_map_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief store x,y,z coordinates of all nodes in mesh. -!! Allocates global arrays 'mesh_node0' and 'mesh_node' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_nodes(fileUnit) - use IO, only: & - IO_lc, & - IO_stringValue, & - IO_floatValue, & - IO_stringPos, & - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,j,m,c - logical :: inPart - - allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) - allocate ( mesh_node (3,mesh_Nnodes), source=0.0_pReal) - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*node' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'print' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'file' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - c = IO_countDataLines(fileUnit) ! how many nodes are defined here? - do i = 1_pInt,c - backspace(fileUnit) ! rewind to first entry - enddo - do i = 1_pInt,c - read (fileUnit,610,END=670) line - chunkPos = IO_stringPos(line) - m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) - do j=1_pInt, 3_pInt - mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) - enddo - enddo - endif - enddo - -670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) - mesh_node = mesh_node0 - -end subroutine mesh_abaqus_build_nodes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', -!! and 'mesh_maxNcellnodes' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_count_cpSizes(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_extractValue ,& - IO_error, & - IO_countDataLines, & - IO_intValue - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line - integer(pInt) :: i,c,t,g - logical :: inPart - - mesh_maxNnodes = 0_pInt - mesh_maxNips = 0_pInt - mesh_maxNipNeighbors = 0_pInt - mesh_maxNcellnodes = 0_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - g = FE_geomtype(t) - c = FE_celltype(g) - mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) - mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) - mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) - mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - endif - enddo - -620 end subroutine mesh_abaqus_count_cpSizes - - -!-------------------------------------------------------------------------------------------------- -!> @brief Store FEid, type, mat, tex, and node list per elemen. -!! Allocates global array 'mesh_element' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_abaqus_build_elements(fileUnit) - - use IO, only: IO_lc, & - IO_stringValue, & - IO_skipChunks, & - IO_stringPos, & - IO_intValue, & - IO_extractValue, & - IO_floatValue, & - IO_countDataLines, & - IO_error - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - - integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead - logical inPart,materialFound - character (len=64) :: materialName,elemSetName - character(len=300) :: line - - allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) - mesh_elemType = -1_pInt - -610 FORMAT(A300) - - inPart = .false. - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - - if( (inPart .or. noPart) .and. & - IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*element' .and. & - ( IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'output' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'matrix' .and. & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) /= 'response' ) & - ) then - t = FE_mapElemtype(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'type')) ! remember elem type - c = IO_countDataLines(fileUnit) - do i = 1_pInt,c - backspace(fileUnit) - enddo - do i = 1_pInt,c - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) ! limit to 64 nodes max - e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) - if (e /= 0_pInt) then ! disregard non CP elems - mesh_element(1,e) = -1_pInt ! DEPRECATED - if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & - call IO_error(191,el=t,ip=mesh_elemType) - mesh_elemType = t - mesh_element(2,e) = t ! elem type - nNodesAlreadyRead = 0_pInt - do j = 1_pInt,chunkPos(1)-1_pInt - mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt+j)) ! put CP ids of nodes to position 5: - enddo - nNodesAlreadyRead = chunkPos(1) - 1_pInt - do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - do j = 1_pInt,chunkPos(1) - mesh_element(4_pInt+nNodesAlreadyRead+j,e) & - = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes - enddo - nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) - enddo - endif - enddo - endif - enddo - - -620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" - - materialFound = .false. - do - read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) - select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) - case('*material') - materialName = trim(IO_extractValue(IO_lc(IO_StringValue(line,chunkPos,2_pInt)),'name')) ! extract name=value - materialFound = materialName /= '' ! valid name? - case('*user') - if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & - materialFound ) then - read (fileUnit,610,END=630) line ! read homogenization and microstructure - chunkPos = IO_stringPos(line) - homog = nint(IO_floatValue(line,chunkPos,1_pInt),pInt) - micro = nint(IO_floatValue(line,chunkPos,2_pInt),pInt) - do i = 1_pInt,mesh_Nmaterials ! look thru material names - if (materialName == mesh_nameMaterial(i)) then ! found one - elemSetName = mesh_mapMaterial(i) ! take corresponding elemSet - do k = 1_pInt,mesh_NelemSets ! look thru all elemSet definitions - if (elemSetName == mesh_nameElemSet(k)) then ! matched? - do j = 1_pInt,mesh_mapElemSet(1,k) - e = mesh_FEasCP('elem',mesh_mapElemSet(1+j,k)) - mesh_element(3,e) = homog ! store homogenization - mesh_element(4,e) = micro ! store microstructure - mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),homog) - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),micro) - enddo - endif - enddo - endif - enddo - materialFound = .false. - endif - endselect - enddo - -630 end subroutine mesh_abaqus_build_elements -#endif - - -!-------------------------------------------------------------------------------------------------- -!> @brief get any additional damask options from input file, sets mesh_periodicSurface -!-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) - -use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - -#ifdef Spectral - mesh_periodicSurface = .true. - - end subroutine mesh_get_damaskOptions - -#else - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword - - mesh_periodicSurface = .false. -#ifdef Marc4DAMASK - keyword = '$damask' -#endif -#ifdef Abaqus - keyword = '**damask' -#endif - - rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - Nchunks = chunkPos(1) - if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read - damaskOption = IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - select case(damaskOption) - case('periodic') ! damask Option that allows to specify periodic fluxes - do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) - v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? - mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' - mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' - mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' - enddo - endselect - endif - enddo - -610 FORMAT(A300) - -620 end subroutine mesh_get_damaskOptions -#endif !-------------------------------------------------------------------------------------------------- @@ -2925,7 +1616,7 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral + !-------------------------------------------------------------------------------------------------- !> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' !-------------------------------------------------------------------------------------------------- @@ -3225,208 +1916,9 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - -end subroutine mesh_build_ipNeighborhood -#endif - - -!-------------------------------------------------------------------------------------------------- -!> @brief write statistics regarding input file parsing to the output file -!-------------------------------------------------------------------------------------------------- -subroutine mesh_tell_statistics - use math, only: & - math_range - use IO, only: & - IO_error - use debug, only: & - debug_level, & - debug_MESH, & - debug_LEVELBASIC, & - debug_LEVELEXTENSIVE, & - debug_LEVELSELECTIVE, & - debug_e, & - debug_i - - implicit none - integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro - character(len=64) :: myFmt - integer(pInt) :: i,e,n,f,t,g,c, myDebug - - myDebug = debug_level(debug_mesh) - - if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified - if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified - - allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2)),source = 0_pInt) - do e = 1_pInt,mesh_NcpElems - if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified - if (mesh_element(4,e) < 1_pInt) call IO_error(error_ID=180_pInt,el=e) ! no microstructure specified - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) = & - mesh_HomogMicro(mesh_element(3,e),mesh_element(4,e)) + 1_pInt ! count combinations of homogenization and microstructure - enddo -!$OMP CRITICAL (write2out) - if (iand(myDebug,debug_levelBasic) /= 0_pInt) then - write(6,'(/,a,/)') ' Input Parser: STATISTICS' - write(6,*) mesh_NcpElems, ' : total number of CP elements in mesh' - write(6,*) mesh_Nnodes, ' : total number of nodes in mesh' - write(6,'(/,a,/)') ' Input Parser: HOMOGENIZATION/MICROSTRUCTURE' - write(6,*) mesh_maxValStateVar(1), ' : maximum homogenization index' - write(6,*) mesh_maxValStateVar(2), ' : maximum microstructure index' - write(6,*) - write (myFmt,'(a,i32.32,a)') '(9x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - write(6,myFmt) '+-',math_range(mesh_maxValStateVar(2)) - write (myFmt,'(a,i32.32,a)') '(i8,1x,a2,1x,',mesh_maxValStateVar(2),'(i8))' - do i=1_pInt,mesh_maxValStateVar(1) ! loop over all (possibly assigned) homogenizations - write(6,myFmt) i,'| ',mesh_HomogMicro(i,:) ! loop over all (possibly assigned) microstructures - enddo - write(6,'(/,a,/)') ' Input Parser: ADDITIONAL MPIE OPTIONS' - write(6,*) 'periodic surface : ', mesh_periodicSurface - write(6,*) - flush(6) - endif - - if (iand(myDebug,debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,/)') 'Input Parser: ELEMENT TYPE' - write(6,'(a8,3(1x,a8))') 'elem','elemtype','geomtype','celltype' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get elemType - g = FE_geomtype(t) ! get elemGeomType - c = FE_celltype(g) ! get cellType - write(6,'(i8,3(1x,i8))') e,t,g,c - enddo - write(6,'(/,a)') 'Input Parser: ELEMENT VOLUME' - write(6,'(/,a13,1x,e15.8)') 'total volume', sum(mesh_ipVolume) - write(6,'(/,a8,1x,a5,1x,a15,1x,a5,1x,a15,1x,a16)') 'elem','IP','volume','face','area','-- normal --' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,1x,e15.8)') e,i,mesh_IPvolume(i,e) - do f = 1_pInt,FE_NipNeighbors(c) - write(6,'(i33,1x,e15.8,1x,3(f6.3,1x))') f,mesh_ipArea(f,i,e),mesh_ipAreaNormal(:,f,i,e) - enddo - enddo - enddo - write(6,'(/,a,/)') 'Input Parser: CELLNODE COORDINATES' - write(6,'(a8,1x,a2,1x,a8,3(1x,a12))') 'elem','IP','cellnode','x','y','z' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i2)') e,i - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in the cell - write(6,'(12x,i8,3(1x,f12.8))') mesh_cell(n,i,e), & - mesh_cellnode(1:3,mesh_cell(n,i,e)) - enddo - enddo - enddo - write(6,'(/,a)') 'Input Parser: IP COORDINATES' - write(6,'(a8,1x,a5,3(1x,a12))') 'elem','IP','x','y','z' - do e = 1_pInt,mesh_NcpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) - enddo - enddo -#ifndef Spectral - write(6,'(/,a,/)') 'Input Parser: NODE TWINS' - write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' - do n = 1_pInt,mesh_Nnodes ! loop over cpNodes - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. .not. any(mesh_element(5:,debug_e) == n)) cycle - write(6,'(i6,3(3x,i6))') n, mesh_nodeTwins(1:3,n) - enddo -#endif - write(6,'(/,a,/)') 'Input Parser: IP NEIGHBORHOOD' - write(6,'(a8,1x,a10,1x,a10,1x,a3,1x,a13,1x,a13)') 'elem','IP','neighbor','','elemNeighbor','ipNeighbor' - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_e /= e) cycle - t = mesh_element(2,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - do i = 1_pInt,FE_Nips(g) ! loop over IPs of elem - if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle - do n = 1_pInt,FE_NipNeighbors(c) ! loop over neighbors of IP - write(6,'(i8,1x,i10,1x,i10,1x,a3,1x,i13,1x,i13)') e,i,n,'-->',mesh_ipNeighborhood(1,n,i,e),mesh_ipNeighborhood(2,n,i,e) - enddo - enddo - enddo - endif -!$OMP END CRITICAL (write2out) - -end subroutine mesh_tell_statistics - - -!-------------------------------------------------------------------------------------------------- -!> @brief mapping of FE element types to internal representation -!-------------------------------------------------------------------------------------------------- -integer(pInt) function FE_mapElemtype(what) - use IO, only: IO_lc, IO_error - - implicit none - character(len=*), intent(in) :: what - - select case (IO_lc(what)) - case ( '6') - FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle - case ( '155', & - '125', & - '128') - FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) - case ( '11', & - 'cpe4', & - 'cpe4t') - FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27', & - 'cpe8', & - 'cpe8t') - FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral - case ( '54') - FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration - case ( '134', & - 'c3d4', & - 'c3d4t') - FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron - case ( '157') - FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations - case ( '127') - FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron - case ( '136', & - 'c3d6', & - 'c3d6t') - FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( '117', & - '123', & - 'c3d8r', & - 'c3d8rt') - FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7', & - 'c3d8', & - 'c3d8t') - FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57', & - 'c3d20r', & - 'c3d20rt') - FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21', & - 'c3d20', & - 'c3d20t') - FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral - case default - call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) - end select - -end function FE_mapElemtype - - -!-------------------------------------------------------------------------------------------------- + + contains + !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) @@ -3512,6 +2004,52 @@ enddo checkCandidate end subroutine mesh_faceMatch +end subroutine mesh_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( 'cpe4', & + 'cpe4t') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( 'cpe8', & + 'cpe8t') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( 'c3d4', & + 'c3d4t') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( 'c3d6', & + 'c3d6t') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( 'c3d8r', & + 'c3d8rt') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( 'c3d8', & + 'c3d8t') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( 'c3d20r', & + 'c3d20rt') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( 'c3d20', & + 'c3d20t') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + + + + !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements @@ -4232,49 +2770,52 @@ end subroutine mesh_build_FEdata !-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes +!> @brief Gives the FE to CP ID mapping by binary search through lookup array +!! valid questions (what) are 'elem', 'node' !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() +integer(pInt) function mesh_FEasCP(what,myID) + use IO, only: & + IO_lc implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID - mesh_get_Ncellnodes = mesh_Ncellnodes + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center -end function mesh_get_Ncellnodes + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),pInt) -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_unitlength -!-------------------------------------------------------------------------------------------------- -real(pReal) function mesh_get_unitlength() - - implicit none - - mesh_get_unitlength = mesh_unitlength - -end function mesh_get_unitlength - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns node that is located at an ip -!> @details return zero if requested ip does not exist or not available (more ips than nodes) -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) - - implicit none - character(len=*), intent(in) :: elemtypeFE - integer(pInt), intent(in) :: ip - integer(pInt) :: elemtype - integer(pInt) :: geomtype - - mesh_get_nodeAtIP = 0_pInt - - elemtype = FE_mapElemtype(elemtypeFE) - geomtype = FE_geomtype(elemtype) - if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & - mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) - -end function mesh_get_nodeAtIP + if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2_pInt,lower) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch +end function mesh_FEasCP end module mesh diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 new file mode 100644 index 000000000..5afdbc3ad --- /dev/null +++ b/src/mesh_base.f90 @@ -0,0 +1,85 @@ + +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Sets up the mesh for the solvers MSC.Marc,FEM, Abaqus and the spectral solver +!-------------------------------------------------------------------------------------------------- +module mesh_base + + use, intrinsic :: iso_c_binding + use prec, only: & + pStringLen, & + pReal, & + pInt + use element, only: & + tElement + + implicit none + +!--------------------------------------------------------------------------------------------------- +!> Properties of a the whole mesh (consisting of one type of elements) +!--------------------------------------------------------------------------------------------------- + type, public :: tMesh + type(tElement) :: & + elem + real(pReal), dimension(:,:), allocatable, public :: & + ipVolume, & !< volume associated with each IP (initially!) + node0, & !< node x,y,z coordinates (initially) + node !< node x,y,z coordinates (deformed) + integer(pInt), dimension(:,:), allocatable, public :: & + cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID + character(pStringLen) :: type = "n/a" + integer(pInt) :: & + Nnodes, & !< total number of nodes in mesh + Nelems = -1_pInt, & + elemType, & + Ncells, & + nIPneighbors, & + NcellNodes, & + maxElemsPerNode + integer(pInt), dimension(:), allocatable, public :: & + homogenizationAt, & + microstructureAt + integer(pInt), dimension(:,:), allocatable, public :: & + connectivity + contains + procedure, pass(self) :: tMesh_base_init + procedure :: setNelems => tMesh_base_setNelems ! not needed once we compute the cells from the connectivity + generic, public :: init => tMesh_base_init + end type tMesh + +contains +subroutine tMesh_base_init(self,meshType,elemType,nodes) + + implicit none + class(tMesh) :: self + character(len=*), intent(in) :: meshType + integer(pInt), intent(in) :: elemType + real(pReal), dimension(:,:), intent(in) :: nodes + + write(6,'(/,a)') ' <<<+- mesh_base_init -+>>>' + + write(6,*)' mesh type ',meshType + write(6,*)' # node ',size(nodes,2) + + self%type = meshType + call self%elem%init(elemType) + self%node0 = nodes + self%nNodes = size(nodes,2) + +end subroutine tMesh_base_init + + +subroutine tMesh_base_setNelems(self,Nelems) + + implicit none + class(tMesh) :: self + integer(pInt), intent(in) :: Nelems + + self%Nelems = Nelems + +end subroutine tMesh_base_setNelems + +end module mesh_base diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 new file mode 100644 index 000000000..424456e3a --- /dev/null +++ b/src/mesh_grid.f90 @@ -0,0 +1,1031 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver +!-------------------------------------------------------------------------------------------------- +module mesh + use, intrinsic :: iso_c_binding + use prec, only: pReal, pInt + use mesh_base + + implicit none + private + integer(pInt), public, protected :: & + mesh_Nnodes, & !< total number of nodes in mesh + mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) + mesh_Ncells, & !< total number of cells in mesh + mesh_maxNipNeighbors, & !< max number of IP neighbors in any CP element + mesh_maxNsharedElems !< max number of CP elements sharing a node + + + integer(pInt), dimension(:), allocatable, private :: & + microGlobal + integer(pInt), dimension(:), allocatable, public, protected :: & + mesh_homogenizationAt, & !< homogenization ID of each element + mesh_microstructureAt !< microstructure ID of each element + + integer(pInt), dimension(:,:), allocatable, public, protected :: & + mesh_element !< entryCount and list of elements containing node + + integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] + + real(pReal), public, protected :: & + mesh_unitlength !< physical length of one unit in mesh + + real(pReal), dimension(:,:), allocatable, public :: & + mesh_node, & !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + mesh_cellnode !< cell node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + + real(pReal), dimension(:,:), allocatable, public, protected :: & + mesh_ipVolume, & !< volume associated with IP (initially!) + mesh_node0 !< node x,y,z coordinates (initially!) + + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + mesh_ipArea !< area of interface to neighboring IP (initially!) + + real(pReal), dimension(:,:,:), allocatable, public :: & + mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) + + logical, dimension(3), public, parameter :: mesh_periodicSurface = .true. !< flag indicating periodic outer surfaces (used for fluxes) + +integer(pInt), dimension(:,:), allocatable, private :: & + mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID + + integer(pInt),dimension(:,:,:), allocatable, private :: & + mesh_cell !< cell connectivity for each element,ip/cell + + integer(pInt), dimension(:,:,:), allocatable, private :: & + FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell + + +! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) +! Hence, I suggest to prefix with "FE_" + + integer(pInt), parameter, private :: & + FE_Ngeomtypes = 10_pInt, & + FE_Ncelltypes = 4_pInt, & + FE_maxNmatchingNodesPerFace = 4_pInt, & + FE_maxNfaces = 6_pInt, & + FE_maxNcellnodesPerCell = 8_pInt, & + FE_maxNcellfaces = 6_pInt, & + FE_maxNcellnodesPerCellface = 4_pInt + + + + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type + int([ & + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 8 & ! (3D 8node) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type + int([& + 2, & ! (2D 3node) + 2, & ! (2D 4node) + 3, & ! (3D 4node) + 4 & ! (3D 8node) + ],pInt) + + + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + int([& + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 6 & ! (3D 8node) + ],pInt) + + + integer(pInt), dimension(3), public, protected :: & + grid !< (global) grid + integer(pInt), public, protected :: & + mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh + grid3, & !< (local) grid in 3rd direction + grid3Offset !< (local) grid offset in 3rd direction + real(pReal), dimension(3), public, protected :: & + geomSize + real(pReal), public, protected :: & + size3, & !< (local) size in 3rd direction + size3offset !< (local) size offset in 3rd direction + + public :: & + mesh_init, & + mesh_cellCenterCoordinates + + private :: & + mesh_build_cellconnectivity, & + mesh_build_ipAreas, & + mesh_build_FEdata, & + mesh_spectral_build_nodes, & + mesh_spectral_build_elements, & + mesh_spectral_build_ipNeighborhood, & + mesh_build_cellnodes, & + mesh_build_ipVolumes, & + mesh_build_ipCoordinates + + type, public, extends(tMesh) :: tMesh_grid + + integer(pInt), dimension(3), public :: & + grid !< (global) grid + integer(pInt), public :: & + mesh_NcpElemsGlobal, & !< total number of CP elements in global mesh + grid3, & !< (local) grid in 3rd direction + grid3Offset !< (local) grid offset in 3rd direction + real(pReal), dimension(3), public :: & + geomSize + real(pReal), public :: & + size3, & !< (local) size in 3rd direction + size3offset + + contains + procedure, pass(self) :: tMesh_grid_init + generic, public :: init => tMesh_grid_init + end type tMesh_grid + + type(tMesh_grid), public, protected :: theMesh + +contains + +subroutine tMesh_grid_init(self,nodes) + + implicit none + class(tMesh_grid) :: self + real(pReal), dimension(:,:), intent(in) :: nodes + + call self%tMesh%init('grid',10_pInt,nodes) + +end subroutine tMesh_grid_init + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the mesh by calling all necessary private routines the mesh module +!! Order and routines strongly depend on type of solver +!-------------------------------------------------------------------------------------------------- +subroutine mesh_init(ip,el) + +#include + use PETScsys + + use DAMASK_interface + use IO, only: & + IO_open_file, & + IO_error, & + IO_timeStamp, & + IO_error, & + IO_write_jobFile + use debug, only: & + debug_e, & + debug_i, & + debug_level, & + debug_mesh, & + debug_levelBasic + use numerics, only: & + numerics_unitlength + use FEsolving, only: & + FEsolving_execElem, & + FEsolving_execIP + + implicit none + include 'fftw3-mpi.f03' + integer(C_INTPTR_T) :: devNull, local_K, local_K_offset + integer :: ierr, worldsize + integer(pInt), intent(in), optional :: el, ip + integer(pInt) :: j + logical :: myDebug + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh + + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + + call fftw_mpi_init() + call mesh_spectral_read_grid() + + + call MPI_comm_size(PETSC_COMM_WORLD, worldsize, ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_comm_size') + if(worldsize>grid(3)) call IO_error(894_pInt, ext_msg='number of processes exceeds grid(3)') + + + devNull = fftw_mpi_local_size_3d(int(grid(3),C_INTPTR_T), & + int(grid(2),C_INTPTR_T), & + int(grid(1),C_INTPTR_T)/2+1, & + PETSC_COMM_WORLD, & + local_K, & ! domain grid size along z + local_K_offset) ! domain grid offset along z + grid3 = int(local_K,pInt) + grid3Offset = int(local_K_offset,pInt) + size3 = geomSize(3)*real(grid3,pReal) /real(grid(3),pReal) + size3Offset = geomSize(3)*real(grid3Offset,pReal)/real(grid(3),pReal) + + mesh_NcpElemsGlobal = product(grid) + + mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) + + call mesh_spectral_build_nodes() + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + + call theMesh%init(mesh_node) + call theMesh%setNelems(product(grid(1:2))*grid3) + mesh_homogenizationAt = mesh_homogenizationAt(product(grid(1:2))*grid3) ! reallocate/shrink in case of MPI + mesh_maxNipNeighbors = theMesh%elem%nIPneighbors + + call mesh_spectral_build_elements() + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) + + + call mesh_build_FEdata ! get properties of the different types of elements + call mesh_build_cellconnectivity + if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) + mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) + if (myDebug) write(6,'(a)') ' Built cell nodes'; flush(6) + call mesh_build_ipCoordinates + if (myDebug) write(6,'(a)') ' Built IP coordinates'; flush(6) + call mesh_build_ipVolumes + if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) + call mesh_build_ipAreas + if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) + + call mesh_spectral_build_ipNeighborhood + + if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) + + if (debug_e < 1 .or. debug_e > theMesh%nElems) & + call IO_error(602_pInt,ext_msg='element') ! selected element does not exist + if (debug_i < 1 .or. debug_i > theMesh%elem%nIPs) & + call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP + + FEsolving_execElem = [ 1_pInt,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2_pInt,theMesh%nElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... + forall (j = 1_pInt:theMesh%nElems) FEsolving_execIP(2,j) = theMesh%elem%nIPs ! ...up to own IP count for each element + + +!!!! COMPATIBILITY HACK !!!! +! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. +! hence, xxPerElem instead of maxXX +! better name + mesh_microstructureAt = mesh_element(4,:) +!!!!!!!!!!!!!!!!!!!!!!!! + deallocate(mesh_cell) +end subroutine mesh_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Parses geometry file +!> @details important variables have an implicit "save" attribute. Therefore, this function is +! supposed to be called only once! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_read_grid() + use IO, only: & + IO_stringPos, & + IO_lc, & + IO_stringValue, & + IO_intValue, & + IO_floatValue, & + IO_error + use DAMASK_interface, only: & + geometryFile + + implicit none + character(len=:), allocatable :: rawData + character(len=65536) :: line + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: h =- 1_pInt + integer(pInt) :: & + headerLength = -1_pInt, & !< length of header (in lines) + fileLength, & !< length of the geom file (in characters) + fileUnit, & + startPos, endPos, & + myStat, & + l, & !< line counter + c, & !< counter for # microstructures in line + o, & !< order of "to" packing + e, & !< "element", i.e. spectral collocation point + i, j + + grid = -1_pInt + geomSize = -1.0_pReal + +!-------------------------------------------------------------------------------------------------- +! read data as stream + inquire(file = trim(geometryFile), size=fileLength) + open(newunit=fileUnit, file=trim(geometryFile), access='stream',& + status='old', position='rewind', action='read',iostat=myStat) + if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(geometryFile)) + allocate(character(len=fileLength)::rawData) + read(fileUnit) rawData + close(fileUnit) + +!-------------------------------------------------------------------------------------------------- +! get header length + endPos = index(rawData,new_line('')) + if(endPos <= index(rawData,'head')) then + startPos = len(rawData) + call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid') + else + chunkPos = IO_stringPos(rawData(1:endPos)) + if (chunkPos(1) < 2_pInt) call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_read_grid') + headerLength = IO_intValue(rawData(1:endPos),chunkPos,1_pInt) + startPos = endPos + 1_pInt + endif + +!-------------------------------------------------------------------------------------------------- +! read and interprete header + l = 0 + do while (l < headerLength .and. startPos < len(rawData)) + endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + if (endPos < startPos) endPos = len(rawData) ! end of file without new line + line = rawData(startPos:endPos) + startPos = endPos + 1_pInt + l = l + 1_pInt + + chunkPos = IO_stringPos(trim(line)) + if (chunkPos(1) < 2) cycle ! need at least one keyword value pair + + select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) ) + case ('grid') + if (chunkPos(1) > 6) then + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + grid(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + grid(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + grid(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + endif + + case ('size') + if (chunkPos(1) > 6) then + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + geomSize(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + geomSize(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + geomSize(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + endif + + case ('homogenization') + if (chunkPos(1) > 1) h = IO_intValue(line,chunkPos,2_pInt) + end select + + enddo + +!-------------------------------------------------------------------------------------------------- +! sanity checks + if(h < 1_pInt) & + call IO_error(error_ID = 842_pInt, ext_msg='homogenization (mesh_spectral_read_grid)') + if(any(grid < 1_pInt)) & + call IO_error(error_ID = 842_pInt, ext_msg='grid (mesh_spectral_read_grid)') + if(any(geomSize < 0.0_pReal)) & + call IO_error(error_ID = 842_pInt, ext_msg='size (mesh_spectral_read_grid)') + + allocate(microGlobal(product(grid)), source = -1_pInt) + allocate(mesh_homogenizationAt(product(grid)), source = h) ! too large in case of MPI (shrink later, not very elegant) + +!-------------------------------------------------------------------------------------------------- +! read and interprete content + e = 1_pInt + do while (startPos < len(rawData)) + endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + if (endPos < startPos) endPos = len(rawData) ! end of file without new line + line = rawData(startPos:endPos) + startPos = endPos + 1_pInt + l = l + 1_pInt + chunkPos = IO_stringPos(trim(line)) + + noCompression: if (chunkPos(1) /= 3) then + c = chunkPos(1) + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] + else noCompression + compression: if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then + c = IO_intValue(line,chunkPos,1) + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,3),i = 1_pInt,IO_intValue(line,chunkPos,1))] + else if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'to') then compression + c = abs(IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1)) + 1_pInt + o = merge(+1_pInt, -1_pInt, IO_intValue(line,chunkPos,3) > IO_intValue(line,chunkPos,1)) + microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3),o)] + else compression + c = chunkPos(1) + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] + endif compression + endif noCompression + + e = e+c + end do + + if (e-1 /= product(grid)) call IO_error(error_ID = 843_pInt, el=e) + +end subroutine mesh_spectral_read_grid + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store x,y,z coordinates of all nodes in mesh. +!! Allocates global arrays 'mesh_node0' and 'mesh_node' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_nodes() + + implicit none + integer(pInt) :: n + + allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) + + forall (n = 0_pInt:mesh_Nnodes-1_pInt) + mesh_node0(1,n+1_pInt) = mesh_unitlength * & + geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & + / real(grid(1),pReal) + mesh_node0(2,n+1_pInt) = mesh_unitlength * & + geomSize(2)*real(mod(n/(grid(1)+1_pInt),(grid(2)+1_pInt)),pReal) & + / real(grid(2),pReal) + mesh_node0(3,n+1_pInt) = mesh_unitlength * & + size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & + / real(grid3,pReal) + & + size3offset + end forall + + mesh_node = mesh_node0 + +end subroutine mesh_spectral_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, material, texture, and node list per element. +!! Allocates global array 'mesh_element' +!> @todo does the IO_error makes sense? +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_elements() + use IO, only: & + IO_error + implicit none + integer(pInt) :: & + e, & + elemOffset + + + allocate(mesh_element (4_pInt+8_pInt,theMesh%nElems), source = 0_pInt) + + elemOffset = product(grid(1:2))*grid3Offset + e = 0_pInt + do while (e < theMesh%nElems) ! fill expected number of elements, stop at end of data + e = e+1_pInt ! valid element entry + mesh_element( 1,e) = -1_pInt ! DEPRECATED + mesh_element( 2,e) = 10_pInt + mesh_element( 3,e) = mesh_homogenizationAt(e) + mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure + mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & + ((e-1_pInt)/(grid(1)*grid(2)))*(grid(1)+1_pInt) ! base node + mesh_element( 6,e) = mesh_element(5,e) + 1_pInt + mesh_element( 7,e) = mesh_element(5,e) + grid(1) + 2_pInt + mesh_element( 8,e) = mesh_element(5,e) + grid(1) + 1_pInt + mesh_element( 9,e) = mesh_element(5,e) +(grid(1) + 1_pInt) * (grid(2) + 1_pInt) ! second floor base node + mesh_element(10,e) = mesh_element(9,e) + 1_pInt + mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt + mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt + enddo + + if (e /= theMesh%nElems) call IO_error(880_pInt,e) + +end subroutine mesh_spectral_build_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief build neighborhood relations for spectral +!> @details assign globals: mesh_ipNeighborhood +!-------------------------------------------------------------------------------------------------- +subroutine mesh_spectral_build_ipNeighborhood + + implicit none + integer(pInt) :: & + x,y,z, & + e + allocate(mesh_ipNeighborhood(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems),source=0_pInt) + + e = 0_pInt + do z = 0_pInt,grid3-1_pInt + do y = 0_pInt,grid(2)-1_pInt + do x = 0_pInt,grid(1)-1_pInt + e = e + 1_pInt + mesh_ipNeighborhood(1,1,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x+1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,2,1,e) = z * grid(1) * grid(2) & + + y * grid(1) & + + modulo(x-1_pInt,grid(1)) & + + 1_pInt + mesh_ipNeighborhood(1,3,1,e) = z * grid(1) * grid(2) & + + modulo(y+1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,4,1,e) = z * grid(1) * grid(2) & + + modulo(y-1_pInt,grid(2)) * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,5,1,e) = modulo(z+1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(1,6,1,e) = modulo(z-1_pInt,grid3) * grid(1) * grid(2) & + + y * grid(1) & + + x & + + 1_pInt + mesh_ipNeighborhood(2,1:6,1,e) = 1_pInt + mesh_ipNeighborhood(3,1,1,e) = 2_pInt + mesh_ipNeighborhood(3,2,1,e) = 1_pInt + mesh_ipNeighborhood(3,3,1,e) = 4_pInt + mesh_ipNeighborhood(3,4,1,e) = 3_pInt + mesh_ipNeighborhood(3,5,1,e) = 6_pInt + mesh_ipNeighborhood(3,6,1,e) = 5_pInt + enddo + enddo + enddo + +end subroutine mesh_spectral_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief builds mesh of (distorted) cubes for given coordinates (= center of the cubes) +!-------------------------------------------------------------------------------------------------- +function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) + use debug, only: & + debug_mesh, & + debug_level, & + debug_levelBasic + use math, only: & + math_mul33x3 + + implicit none + real(pReal), intent(in), dimension(:,:,:,:) :: & + centres + real(pReal), dimension(3,size(centres,2)+1,size(centres,3)+1,size(centres,4)+1) :: & + nodes + real(pReal), intent(in), dimension(3) :: & + gDim + real(pReal), intent(in), dimension(3,3) :: & + Favg + real(pReal), dimension(3,size(centres,2)+2,size(centres,3)+2,size(centres,4)+2) :: & + wrappedCentres + + integer(pInt) :: & + i,j,k,n + integer(pInt), dimension(3), parameter :: & + diag = 1_pInt + integer(pInt), dimension(3) :: & + shift = 0_pInt, & + lookup = 0_pInt, & + me = 0_pInt, & + iRes = 0_pInt + integer(pInt), dimension(3,8) :: & + neighbor = reshape([ & + 0_pInt, 0_pInt, 0_pInt, & + 1_pInt, 0_pInt, 0_pInt, & + 1_pInt, 1_pInt, 0_pInt, & + 0_pInt, 1_pInt, 0_pInt, & + 0_pInt, 0_pInt, 1_pInt, & + 1_pInt, 0_pInt, 1_pInt, & + 1_pInt, 1_pInt, 1_pInt, & + 0_pInt, 1_pInt, 1_pInt ], [3,8]) + +!-------------------------------------------------------------------------------------------------- +! initializing variables + iRes = [size(centres,2),size(centres,3),size(centres,4)] + nodes = 0.0_pReal + wrappedCentres = 0.0_pReal + +!-------------------------------------------------------------------------------------------------- +! report + if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then + write(6,'(a)') ' Meshing cubes around centroids' + write(6,'(a,3(e12.5))') ' Dimension: ', gDim + write(6,'(a,3(i5))') ' Resolution:', iRes + endif + +!-------------------------------------------------------------------------------------------------- +! building wrappedCentres = centroids + ghosts + wrappedCentres(1:3,2_pInt:iRes(1)+1_pInt,2_pInt:iRes(2)+1_pInt,2_pInt:iRes(3)+1_pInt) = centres + do k = 0_pInt,iRes(3)+1_pInt + do j = 0_pInt,iRes(2)+1_pInt + do i = 0_pInt,iRes(1)+1_pInt + if (k==0_pInt .or. k==iRes(3)+1_pInt .or. & ! z skin + j==0_pInt .or. j==iRes(2)+1_pInt .or. & ! y skin + i==0_pInt .or. i==iRes(1)+1_pInt ) then ! x skin + me = [i,j,k] ! me on skin + shift = sign(abs(iRes+diag-2_pInt*me)/(iRes+diag),iRes+diag-2_pInt*me) + lookup = me-diag+shift*iRes + wrappedCentres(1:3,i+1_pInt, j+1_pInt, k+1_pInt) = & + centres(1:3,lookup(1)+1_pInt,lookup(2)+1_pInt,lookup(3)+1_pInt) & + - math_mul33x3(Favg, real(shift,pReal)*gDim) + endif + enddo; enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! averaging + do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) + do n = 1_pInt,8_pInt + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) = & + nodes(1:3,i+1_pInt,j+1_pInt,k+1_pInt) + wrappedCentres(1:3,i+1_pInt+neighbor(1,n), & + j+1_pInt+neighbor(2,n), & + k+1_pInt+neighbor(3,n) ) + enddo + enddo; enddo; enddo + nodes = nodes/8.0_pReal + +end function mesh_nodesAroundCentres + + +!################################################################################################################# +!################################################################################################################# +!################################################################################################################# +! The following routines are not solver specific and should be included in mesh_base (most likely in modified form) +!################################################################################################################# +!################################################################################################################# +!################################################################################################################# + + + +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(theMesh%elem%Ncellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,n,i, & + matchingNodeID, & + localCellnodeID + + integer(pInt), dimension(FE_Ngeomtypes), parameter :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 8 & ! element 21 (3D 20node 27ip) + ],pInt) + + allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,theMesh%nElems), source=0_pInt) + allocate(matchingNode2cellnode(theMesh%nNodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,theMesh%elem%Ncellnodes*theMesh%nElems), source=0_pInt) + + mesh_Ncells = theMesh%nElems*theMesh%elem%nIPs +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + + do e = 1_pInt,theMesh%nElems + localCellnode2globalCellnode = 0_pInt + do i = 1_pInt,theMesh%elem%nIPs + do n = 1_pInt,theMesh%elem%NcellnodesPerCell + localCellnodeID = theMesh%elem%cell(n,i) + if (localCellnodeID <= FE_NmatchingNodes(theMesh%elem%geomType)) then ! this cell node is a matching node + matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) + else ! this cell node is no matching node + if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes + real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes + + integer(pInt) :: & + e,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,myCoords) + do n = 1_pInt,Ncellnodes ! loop over cell nodes + e = mesh_cellnodeParent(1,n) + localCellnodeID = mesh_cellnodeParent(2,n) + myCoords = 0.0_pReal + do m = 1_pInt,theMesh%elem%nNodes + myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + * theMesh%elem%cellNodeParentNodeWeights(m,localCellnodeID) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(theMesh%elem%cellNodeParentNodeWeights(:,localCellnodeID)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: e,t,g,c,i,m,f,n + real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume + + + allocate(mesh_ipVolume(theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) + + + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) + do e = 1_pInt,theMesh%nElems ! loop over cpElems + select case (theMesh%elem%cellType) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) + + case (2_pInt) ! 2D 4node + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e)), & + mesh_cellnode(1:3,mesh_cell(1,i,e))) + + case (3_pInt) ! 3D 4node + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e))) + + case (4_pInt) + c = theMesh%elem%cellType ! 3D 8node + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + subvolume = 0.0_pReal + forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + subvolume(n,f) = math_volTetrahedron(& + mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: e,c,i,n + real(pReal), dimension(3) :: myCoords + + if (.not. allocated(mesh_ipCoordinates)) & + allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(c,myCoords) + do e = 1_pInt,theMesh%nElems ! loop over cpElems + c = theMesh%elem%cellType + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + myCoords = 0.0_pReal + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e)) + enddo + mesh_ipCoordinates(1:3,i,e) = myCoords / real(FE_NcellnodesPerCell(c),pReal) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), intent(in) :: el, & !< element number + ip !< integration point number + real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell + integer(pInt) :: c,n + + c = theMesh%elem%cellType + mesh_cellCenterCoordinates = 0.0_pReal + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) + enddo + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) + +end function mesh_cellCenterCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipAreas + use math, only: & + math_crossproduct + + implicit none + integer(pInt) :: e,t,g,c,i,f,n,m + real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals + real(pReal), dimension(3) :: normal + + allocate(mesh_ipArea(theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) + do e = 1_pInt,theMesh%nElems ! loop over cpElems + c = theMesh%elem%cellType + select case (c) + + case (1_pInt,2_pInt) ! 2D 3 or 4 node + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal(1) = nodePos(2,2) - nodePos(2,1) ! x_normal = y_connectingVector + normal(2) = -(nodePos(1,2) - nodePos(1,1)) ! y_normal = -x_connectingVector + normal(3) = 0.0_pReal + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (3_pInt) ! 3D 4node + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal = math_crossproduct(nodePos(1:3,2) - nodePos(1:3,1), & + nodePos(1:3,3) - nodePos(1:3,1)) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (4_pInt) ! 3D 8node + ! for this cell type we get the normal of the quadrilateral face as an average of + ! four normals of triangular subfaces; since the face consists only of two triangles, + ! the sum has to be divided by two; this whole prcedure tries to compensate for + ! probable non-planar cell surfaces + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + normals(1:3,n) = 0.5_pReal & + * math_crossproduct(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & + nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) + normal = 0.5_pReal * sum(normals,2) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) + enddo + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipAreas + + +!-------------------------------------------------------------------------------------------------- +!> @brief get properties of different types of finite elements +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_subNodeOnIPFace +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_FEdata + + implicit none + integer(pInt) :: me + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + + + ! *** FE_cellface *** + me = 0_pInt + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) + reshape(int([& + 2,3, & + 3,1, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) + reshape(int([& + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) + reshape(int([& + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) + reshape(int([& + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + +end subroutine mesh_build_FEdata + + +end module mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 new file mode 100644 index 000000000..0c7d332c9 --- /dev/null +++ b/src/mesh_marc.f90 @@ -0,0 +1,1851 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Sets up the mesh for the solver MSC.Marc +!-------------------------------------------------------------------------------------------------- +module mesh + use prec, only: pReal, pInt + use mesh_base + + implicit none + private + integer(pInt), public, protected :: & + mesh_elemType, & !< Element type of the mesh (only support homogeneous meshes) + mesh_Nnodes, & !< total number of nodes in mesh + mesh_Ncellnodes, & !< total number of cell nodes in mesh (including duplicates) + mesh_Ncells, & !< total number of cells in mesh + mesh_maxNsharedElems !< max number of CP elements sharing a node + + integer(pInt), dimension(:), allocatable, public, protected :: & + mesh_homogenizationAt, & !< homogenization ID of each element + mesh_microstructureAt !< microstructure ID of each element + + integer(pInt), dimension(:,:), allocatable, public, protected :: & + mesh_element, & !DEPRECATED + mesh_sharedElem, & !< entryCount and list of elements containing node + mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) + + integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] + + real(pReal), public, protected :: & + mesh_unitlength !< physical length of one unit in mesh + + real(pReal), dimension(:,:), allocatable, public :: & + mesh_node, & !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + mesh_cellnode !< cell node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + + real(pReal), dimension(:,:), allocatable, public, protected :: & + mesh_ipVolume, & !< volume associated with IP (initially!) + mesh_node0 !< node x,y,z coordinates (initially!) + + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + mesh_ipArea !< area of interface to neighboring IP (initially!) + + real(pReal), dimension(:,:,:), allocatable, public :: & + mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) + + logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) + + +integer(pInt), dimension(:,:), allocatable, private :: & + mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID + + integer(pInt),dimension(:,:,:), allocatable, private :: & + mesh_cell !< cell connectivity for each element,ip/cell + + integer(pInt), dimension(:,:,:), allocatable, private :: & + FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell + + +! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) +! Hence, I suggest to prefix with "FE_" + + integer(pInt), parameter, public :: & + FE_Nelemtypes = 13_pInt, & + FE_Ngeomtypes = 10_pInt, & + FE_Ncelltypes = 4_pInt, & + FE_maxNipNeighbors = 6_pInt, & + FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP + FE_maxNmatchingNodesPerFace = 4_pInt, & + FE_maxNfaces = 6_pInt, & + FE_maxNcellnodes = 64_pInt, & + FE_maxNcellnodesPerCell = 8_pInt, & + FE_maxNcellfaces = 6_pInt, & + FE_maxNcellnodesPerCellface = 4_pInt + + + integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Nfaces = & !< number of faces of a specific type of element geometry + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 5, & ! element 136 (3D 6node 6ip) + 6, & ! element 117 (3D 8node 1ip) + 6, & ! element 7 (3D 8node 8ip) + 6 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_NmatchingNodes = & !< number of nodes that are needed for face matching in a specific type of element geometry + int([ & + 3, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 8 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_maxNfaces,FE_Ngeomtypes), parameter, private :: & + FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry + reshape(int([ & + 2,2,2,0,0,0, & ! element 6 (2D 3node 1ip) + 2,2,2,0,0,0, & ! element 125 (2D 6node 3ip) + 2,2,2,2,0,0, & ! element 11 (2D 4node 4ip) + 2,2,2,2,0,0, & ! element 27 (2D 8node 9ip) + 3,3,3,3,0,0, & ! element 134 (3D 4node 1ip) + 3,3,3,3,0,0, & ! element 127 (3D 10node 4ip) + 3,4,4,4,3,0, & ! element 136 (3D 6node 6ip) + 4,4,4,4,4,4, & ! element 117 (3D 8node 1ip) + 4,4,4,4,4,4, & ! element 7 (3D 8node 8ip) + 4,4,4,4,4,4 & ! element 21 (3D 20node 27ip) + ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) + + integer(pInt), dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & + parameter, private :: FE_face = & !< List of node indices on each face of a specific type of element geometry + reshape(int([& + 1,2,0,0 , & ! element 6 (2D 3node 1ip) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 125 (2D 6node 3ip) + 2,3,0,0 , & + 3,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 11 (2D 4node 4ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,0,0 , & ! element 27 (2D 8node 9ip) + 2,3,0,0 , & + 3,4,0,0 , & + 4,1,0,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 134 (3D 4node 1ip) + 1,4,2,0 , & + 2,3,4,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 127 (3D 10node 4ip) + 1,4,2,0 , & + 2,4,3,0 , & + 1,3,4,0 , & + 0,0,0,0 , & + 0,0,0,0 , & + 1,2,3,0 , & ! element 136 (3D 6node 6ip) + 1,4,5,2 , & + 2,5,6,3 , & + 1,3,6,4 , & + 4,6,5,0 , & + 0,0,0,0 , & + 1,2,3,4 , & ! element 117 (3D 8node 1ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 7 (3D 8node 8ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 , & + 1,2,3,4 , & ! element 21 (3D 20node 27ip) + 2,1,5,6 , & + 3,2,6,7 , & + 4,3,7,8 , & + 4,1,5,8 , & + 8,7,6,5 & + ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) + + + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCellface = & !< number of cell nodes per cell face in a specific cell type + int([& + 2, & ! (2D 3node) + 2, & ! (2D 4node) + 3, & ! (3D 4node) + 4 & ! (3D 8node) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + int([& + 3, & ! (2D 3node) + 4, & ! (2D 4node) + 4, & ! (3D 4node) + 6 & ! (3D 8node) + ],pInt) + + + integer(pInt), private :: & + mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) + mesh_NelemSets + character(len=64), dimension(:), allocatable, private :: & + mesh_nameElemSet + + integer(pInt), dimension(:,:), allocatable, private :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(:,:), allocatable, target, private :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] + + + integer(pInt), private :: & + MarcVersion, & !< Version of input file format (Marc only) + hypoelasticTableStyle, & !< Table style (Marc only) + initialcondTableStyle !< Table style (Marc only) + integer(pInt), dimension(:), allocatable, private :: & + Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) + + public :: & + mesh_init, & + mesh_build_cellnodes, & + mesh_build_ipVolumes, & + mesh_build_ipCoordinates, & + mesh_cellCenterCoordinates, & + mesh_FEasCP + + + private :: & + mesh_get_damaskOptions, & + mesh_build_cellconnectivity, & + mesh_build_ipAreas, & + FE_mapElemtype, & + mesh_build_FEdata, & + mesh_build_nodeTwins, & + mesh_build_sharedElems, & + mesh_build_ipNeighborhood, & + mesh_marc_get_fileFormat, & + mesh_marc_get_tableStyles, & + mesh_marc_get_matNumber, & + mesh_marc_count_nodesAndElements, & + mesh_marc_count_elementSets, & + mesh_marc_map_elementSets, & + mesh_marc_map_Elements, & + mesh_marc_map_nodes, & + mesh_marc_build_nodes, & + mesh_marc_build_elements + +type, public, extends(tMesh) :: tMesh_marc + + contains + procedure, pass(self) :: tMesh_marc_init + generic, public :: init => tMesh_marc_init +end type tMesh_marc + + type(tMesh_marc), public, protected :: theMesh + + +contains + +subroutine tMesh_marc_init(self,elemType,nodes) + + implicit none + class(tMesh_marc) :: self + real(pReal), dimension(:,:), intent(in) :: nodes + integer(pInt), intent(in) :: elemType + + call self%tMesh%init('mesh',elemType,nodes) + +end subroutine tMesh_marc_init + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the mesh by calling all necessary private routines the mesh module +!! Order and routines strongly depend on type of solver +!-------------------------------------------------------------------------------------------------- +subroutine mesh_init(ip,el) + use DAMASK_interface + use IO, only: & + IO_open_InputFile, & + IO_timeStamp, & + IO_error, & + IO_write_jobFile + use debug, only: & + debug_e, & + debug_i, & + debug_level, & + debug_mesh, & + debug_levelBasic + use numerics, only: & + usePingPong, & + numerics_unitlength, & + worldrank + use FEsolving, only: & + modelName, & + calcMode, & + FEsolving_execElem, & + FEsolving_execIP + + implicit none + integer(pInt), intent(in) :: el, ip + + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt) :: j, fileFormatVersion, elemType + integer(pInt) :: & + mesh_maxNelemInSet, & + mesh_NcpElems + logical :: myDebug + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + + mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh + + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) + + call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... + if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + + MarcVersion = mesh_marc_get_fileFormat(FILEUNIT) + fileFormatVersion = MarcVersion + if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) + + call mesh_marc_get_tableStyles(initialcondTableStyle,hypoelasticTableStyle,FILEUNIT) + if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) + + if (fileFormatVersion > 12) then + Marc_matNumber = mesh_marc_get_matNumber(FILEUNIT,hypoelasticTableStyle) + if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) + endif + + call mesh_marc_count_nodesAndElements(mesh_nNodes, mesh_nElems, FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + + call mesh_marc_count_elementSets(mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + + allocate(mesh_nameElemSet(mesh_NelemSets)); mesh_nameElemSet = 'n/a' + allocate(mesh_mapElemSet(1_pInt+mesh_maxNelemInSet,mesh_NelemSets),source=0_pInt) + call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + + mesh_NcpElems = mesh_nElems + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + call mesh_marc_map_elements(hypoelasticTableStyle,mesh_nameElemSet,mesh_mapElemSet,mesh_NcpElems,FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + call mesh_marc_map_nodes(mesh_Nnodes,FILEUNIT) !ToDo: don't work on global variables + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + + call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables + mesh_node = mesh_node0 + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + + elemType = mesh_marc_count_cpSizes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP sizes'; flush(6) + + call theMesh%init(elemType,mesh_node0) + call theMesh%setNelems(mesh_NcpElems) + + call mesh_marc_build_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) + call mesh_get_damaskOptions(mesh_periodicSurface,FILEUNIT) + if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + close (FILEUNIT) + + + call mesh_build_FEdata ! get properties of the different types of elements + call mesh_build_cellconnectivity + if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) + mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) + if (myDebug) write(6,'(a)') ' Built cell nodes'; flush(6) + call mesh_build_ipCoordinates + if (myDebug) write(6,'(a)') ' Built IP coordinates'; flush(6) + call mesh_build_ipVolumes + if (myDebug) write(6,'(a)') ' Built IP volumes'; flush(6) + call mesh_build_ipAreas + if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) + + + call mesh_build_nodeTwins + if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) + call mesh_build_sharedElems + if (myDebug) write(6,'(a)') ' Built shared elements'; flush(6) + call mesh_build_ipNeighborhood + if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) + + if (usePingPong .and. (mesh_Nelems /= theMesh%nElems)) & + call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements + if (debug_e < 1 .or. debug_e > theMesh%nElems) & + call IO_error(602_pInt,ext_msg='element') ! selected element does not exist + if (debug_i < 1 .or. debug_i > theMesh%elem%nIPs) & + call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP + + FEsolving_execElem = [ 1_pInt,theMesh%nElems ] ! parallel loop bounds set to comprise all DAMASK elements + allocate(FEsolving_execIP(2_pInt,theMesh%nElems), source=1_pInt) ! parallel loop bounds set to comprise from first IP... + FEsolving_execIP(2,:) = theMesh%elem%nIPs + + allocate(calcMode(theMesh%elem%nIPs,theMesh%nElems)) + calcMode = .false. ! pretend to have collected what first call is asking (F = I) + calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" + +!!!! COMPATIBILITY HACK !!!! +! better name + mesh_homogenizationAt = mesh_element(3,:) + mesh_microstructureAt = mesh_element(4,:) +!!!!!!!!!!!!!!!!!!!!!!!! + +end subroutine mesh_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out version of Marc input file format +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_marc_get_fileFormat(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then + mesh_marc_get_fileFormat = IO_intValue(line,chunkPos,2_pInt) + exit + endif + enddo + +620 end function mesh_marc_get_fileFormat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out table styles for initial cond and hypoelastic +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(out) :: initialcond, hypoelastic + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + initialcond = 0_pInt + hypoelastic = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'table' .and. chunkPos(1_pInt) > 5) then + initialcond = IO_intValue(line,chunkPos,4_pInt) + hypoelastic = IO_intValue(line,chunkPos,5_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_tableStyles + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out material number of hypoelastic material +!-------------------------------------------------------------------------------------------------- +function mesh_marc_get_matNumber(fileUnit,tableStyle) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit, tableStyle + integer(pInt), dimension(:), allocatable :: mesh_marc_get_matNumber + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i, j, data_blocks + character(len=300) line + + + rewind(fileUnit) + + data_blocks = 1_pInt + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + read (fileUnit,'(A300)',END=620) line + if (len(trim(line))/=0_pInt) then + chunkPos = IO_stringPos(line) + data_blocks = IO_intValue(line,chunkPos,1_pInt) + endif + allocate(mesh_marc_get_matNumber(data_blocks), source = 0_pInt) + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + mesh_marc_get_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) + do j=1_pint,2_pInt + tableStyle ! read 2 or 3 remaining lines of data block + read (fileUnit,'(A300)') line + enddo + enddo + exit + endif + enddo + +620 end function mesh_marc_get_matNumber + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of nodes and elements +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_IntValue + + implicit none + integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: nNodes, nElems + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + nNodes = 0_pInt + nElems = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & + nElems = IO_IntValue (line,chunkPos,3_pInt) + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'coordinates') then + read (fileUnit,'(A300)') line + chunkPos = IO_stringPos(line) + nNodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file + endif + enddo + +620 end subroutine mesh_marc_count_nodesAndElements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Count overall number of element sets in mesh. +!-------------------------------------------------------------------------------------------------- + subroutine mesh_marc_count_elementSets(nElemSets,maxNelemInSet,fileUnit) + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_countContinuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: nElemSets, maxNelemInSet + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + + nElemSets = 0_pInt + maxNelemInSet = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + + if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & + IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'element' ) then + nElemSets = nElemSets + 1_pInt + maxNelemInSet = max(maxNelemInSet, IO_countContinuousIntValues(fileUnit)) + endif + enddo + +620 end subroutine mesh_marc_count_elementSets + + +!-------------------------------------------------------------------------------------------------- +!> @brief map element sets +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit + character(len=64), dimension(:), intent(out) :: & + nameElemSet + integer(pInt), dimension(:,:), intent(out) :: & + mapElemSet + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: elemSet + + elemSet = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=640) line + chunkPos = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'define' ) .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'element' ) ) then + elemSet = elemSet+1_pInt + nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,size(mapElemSet,1)-1,nameElemSet,mapElemSet,size(nameElemSet)) + endif + enddo + +640 end subroutine mesh_marc_map_elementSets + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps elements from FE ID to internal (consecutive) representation. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos, & + IO_continuousIntValues + + implicit none + integer(pInt), intent(in) :: fileUnit,tableStyle,nElems + character(len=64), intent(in), dimension(:) :: nameElemSet + integer(pInt), dimension(:,:), intent(in) :: & + mapElemSet + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line, & + tmp + + integer(pInt), dimension (1_pInt+nElems) :: contInts + integer(pInt) :: i,cpElem + + cpElem = 0_pInt + contInts = 0_pInt + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=660) line + chunkPos = IO_stringPos(line) + if (MarcVersion < 13) then ! Marc 2016 or earlier + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then + do i=1_pInt,3_pInt+TableStyle ! skip three (or four if new table style!) lines + read (fileUnit,'(A300)') line + enddo + contInts = IO_continuousIntValues(fileUnit,nElems,nameElemSet,& + mapElemSet,size(nameElemSet)) + exit + endif + else ! Marc2017 and later + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,'(A300)',END=660) line + chunkPos = IO_stringPos(line) + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + do + read (fileUnit,'(A300)',END=660) line + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + exit + else + contInts(1) = contInts(1) + 1_pInt + read (tmp,*) contInts(contInts(1)+1) + endif + enddo + endif + endif + endif + enddo +660 do i = 1_pInt,contInts(1) + cpElem = cpElem+1_pInt + mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) + mesh_mapFEtoCPelem(2,cpElem) = cpElem + enddo + +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + +end subroutine mesh_marc_map_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief Maps node from FE ID to internal (consecutive) representation. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_nodes(nNodes,fileUnit) + + use math, only: math_qsort + use IO, only: IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue + + implicit none + integer(pInt), intent(in) :: fileUnit, nNodes + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension (nNodes) :: node_count + integer(pInt) :: i + + node_count = 0_pInt + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=650) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,'(A300)') line ! skip crap line + do i = 1_pInt,nNodes + read (fileUnit,'(A300)') line + mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[0_pInt,10_pInt],1_pInt) + mesh_mapFEtoCPnode(2_pInt,i) = i + enddo + exit + endif + enddo + +650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + +end subroutine mesh_marc_map_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief store x,y,z coordinates of all nodes in mesh. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_nodes(fileUnit) + + use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos, & + IO_fixedIntValue, & + IO_fixedNoEFloatValue + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), dimension(5), parameter :: node_ends = int([0,10,30,50,70],pInt) + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,j,m + + allocate ( mesh_node0 (3,mesh_Nnodes), source=0.0_pReal) + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=670) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'coordinates' ) then + read (fileUnit,'(A300)') line ! skip crap line + do i=1_pInt,mesh_Nnodes + read (fileUnit,'(A300)') line + m = mesh_FEasCP('node',IO_fixedIntValue(line,node_ends,1_pInt)) + do j = 1_pInt,3_pInt + mesh_node0(j,m) = mesh_unitlength * IO_fixedNoEFloatValue(line,node_ends,j+1_pInt) + enddo + enddo + exit + endif + enddo + +670 mesh_node = mesh_node0 + +end subroutine mesh_marc_build_nodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! and 'mesh_maxNcellnodes' +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_marc_count_cpSizes(fileUnit) + + use IO, only: IO_lc, & + IO_error, & + IO_stringValue, & + IO_stringPos, & + IO_intValue, & + IO_skipChunks + use element + + implicit none + integer(pInt), intent(in) :: fileUnit + + type(tElement) :: tempEl + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer(pInt) :: i,t,g,e,c + + t = -1_pInt + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=630) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,'(A300)') line ! Garbage line + do i=1_pInt,mesh_Nelems ! read all elements + read (fileUnit,'(A300)') line + chunkPos = IO_stringPos(line) ! limit to id and type + if (t == -1_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + call tempEl%init(t) + mesh_marc_count_cpSizes = t + else + if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message + endif + call IO_skipChunks(fileUnit,tempEl%nNodes-(chunkPos(1_pInt)-2_pInt)) + enddo + exit + endif + enddo + +630 end function mesh_marc_count_cpSizes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Store FEid, type, mat, tex, and node list per element. +!! Allocates global array 'mesh_element' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_build_elements(fileUnit) + + use IO, only: IO_lc, & + IO_stringValue, & + IO_fixedNoEFloatValue, & + IO_skipChunks, & + IO_stringPos, & + IO_intValue, & + IO_continuousIntValues, & + IO_error + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + + integer(pInt), dimension(1_pInt+theMesh%nElems) :: contInts + integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead + + allocate(mesh_element(4_pInt+theMesh%elem%nNodes,theMesh%nElems), source=0_pInt) + mesh_elemType = -1_pInt + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity' ) then + read (fileUnit,'(A300)',END=620) line ! garbage line + do i = 1_pInt,mesh_Nelems + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) + if (e /= 0_pInt) then ! disregard non CP elems + mesh_element(1,e) = -1_pInt ! DEPRECATED + t = FE_mapElemtype(IO_StringValue(line,chunkPos,2_pInt)) ! elem type + if (mesh_elemType /= t .and. mesh_elemType /= -1_pInt) & + call IO_error(191,el=t,ip=mesh_elemType) + mesh_elemType = t + mesh_element(2,e) = t + nNodesAlreadyRead = 0_pInt + do j = 1_pInt,chunkPos(1)-2_pInt + mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes + enddo + nNodesAlreadyRead = chunkPos(1) - 2_pInt + do while(nNodesAlreadyRead < theMesh%elem%nNodes) ! read on if not all nodes in one line + read (fileUnit,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + do j = 1_pInt,chunkPos(1) + mesh_element(4_pInt+nNodesAlreadyRead+j,e) & + = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j)) ! CP ids of nodes + enddo + nNodesAlreadyRead = nNodesAlreadyRead + chunkPos(1) + enddo + endif + enddo + exit + endif + enddo + +620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" + read (fileUnit,'(A300)',END=630) line + do + chunkPos = IO_stringPos(line) + if( (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'initial') .and. & + (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'state') ) then + if (initialcondTableStyle == 2_pInt) read (fileUnit,'(A300)',END=630) line ! read extra line for new style + read (fileUnit,'(A300)',END=630) line ! read line with index of state var + chunkPos = IO_stringPos(line) + sv = IO_IntValue(line,chunkPos,1_pInt) ! figure state variable index + if( (sv == 2_pInt).or.(sv == 3_pInt) ) then ! only state vars 2 and 3 of interest + read (fileUnit,'(A300)',END=630) line ! read line with value of state var + chunkPos = IO_stringPos(line) + do while (scan(IO_stringValue(line,chunkPos,1_pInt),'+-',back=.true.)>1) ! is noEfloat value? + myVal = nint(IO_fixedNoEFloatValue(line,[0_pInt,20_pInt],1_pInt),pInt) ! state var's value + if (initialcondTableStyle == 2_pInt) then + read (fileUnit,'(A300)',END=630) line ! read extra line + read (fileUnit,'(A300)',END=630) line ! read extra line + endif + contInts = IO_continuousIntValues& ! get affected elements + (fileUnit,theMesh%nElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + do i = 1_pInt,contInts(1) + e = mesh_FEasCP('elem',contInts(1_pInt+i)) + mesh_element(1_pInt+sv,e) = myVal + enddo + if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=630) line ! ignore IP range for old table style + read (fileUnit,'(A300)',END=630) line + chunkPos = IO_stringPos(line) + enddo + endif + else + read (fileUnit,'(A300)',END=630) line + endif + enddo + +630 end subroutine mesh_marc_build_elements + + +!-------------------------------------------------------------------------------------------------- +!> @brief get any additional damask options from input file, sets mesh_periodicSurface +!-------------------------------------------------------------------------------------------------- +subroutine mesh_get_damaskOptions(periodic_surface,fileUnit) + +use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + integer(pInt) :: chunk, Nchunks + character(len=300) :: v + logical, dimension(3) :: periodic_surface + + + periodic_surface = .false. + myStat = 0 + rewind(fileUnit) + do while(myStat == 0) + read (fileUnit,'(a300)',iostat=myStat) line + chunkPos = IO_stringPos(line) + Nchunks = chunkPos(1) + if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '$damask' .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read + select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) + case('periodic') ! damask Option that allows to specify periodic fluxes + do chunk = 3_pInt,Nchunks ! loop through chunks (skipping the keyword) + v = IO_lc(IO_stringValue(line,chunkPos,chunk)) ! chunk matches keyvalues x,y, or z? + mesh_periodicSurface(1) = mesh_periodicSurface(1) .or. v == 'x' + mesh_periodicSurface(2) = mesh_periodicSurface(2) .or. v == 'y' + mesh_periodicSurface(3) = mesh_periodicSurface(3) .or. v == 'z' + enddo + endselect + endif + enddo + +end subroutine mesh_get_damaskOptions + +!-------------------------------------------------------------------------------------------------- +!> @brief Split CP elements into cells. +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> all others (currently) might be stored more than once. +!> Also allocates the 'mesh_node' array. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_cellconnectivity + + implicit none + integer(pInt), dimension(:), allocatable :: & + matchingNode2cellnode + integer(pInt), dimension(:,:), allocatable :: & + cellnodeParent + integer(pInt), dimension(theMesh%elem%Ncellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,n,i, & + matchingNodeID, & + localCellnodeID + + allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,theMesh%nElems), source=0_pInt) + allocate(matchingNode2cellnode(theMesh%nNodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,theMesh%elem%Ncellnodes*theMesh%nElems), source=0_pInt) + + mesh_Ncells = theMesh%nElems*theMesh%elem%nIPs +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + + do e = 1_pInt,theMesh%nElems + localCellnode2globalCellnode = 0_pInt + do i = 1_pInt,theMesh%elem%nIPs + do n = 1_pInt,theMesh%elem%NcellnodesPerCell + localCellnodeID = theMesh%elem%cell(n,i) + if (localCellnodeID <= FE_NmatchingNodes(theMesh%elem%geomType)) then ! this cell node is a matching node + matchingNodeID = mesh_element(4_pInt+localCellnodeID,e) + if (matchingNode2cellnode(matchingNodeID) == 0_pInt) then ! if this matching node does not yet exist in the glbal cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + matchingNode2cellnode(matchingNodeID) = mesh_Ncellnodes ! ... and remember its global ID + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and where it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = matchingNode2cellnode(matchingNodeID) + else ! this cell node is no matching node + if (localCellnode2globalCellnode(localCellnodeID) == 0_pInt) then ! if this local cell node does not yet exist in the global cell node list ... + mesh_Ncellnodes = mesh_Ncellnodes + 1_pInt ! ... count it as cell node ... + localCellnode2globalCellnode(localCellnodeID) = mesh_Ncellnodes ! ... and remember its global ID ... + cellnodeParent(1_pInt,mesh_Ncellnodes) = e ! ... and it belongs to + cellnodeParent(2_pInt,mesh_Ncellnodes) = localCellnodeID + endif + mesh_cell(n,i,e) = localCellnode2globalCellnode(localCellnodeID) + endif + enddo + enddo + enddo + + allocate(mesh_cellnodeParent(2_pInt,mesh_Ncellnodes)) + allocate(mesh_cellnode(3_pInt,mesh_Ncellnodes)) + + forall(n = 1_pInt:mesh_Ncellnodes) + mesh_cellnodeParent(1,n) = cellnodeParent(1,n) + mesh_cellnodeParent(2,n) = cellnodeParent(2,n) + endforall + +end subroutine mesh_build_cellconnectivity + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculate position of cellnodes from the given position of nodes +!> Build list of cellnodes' coordinates. +!> Cellnode coordinates are calculated from a weighted sum of node coordinates. +!-------------------------------------------------------------------------------------------------- +function mesh_build_cellnodes(nodes,Ncellnodes) + + implicit none + integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes + real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes + real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes + + integer(pInt) :: & + e,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,myCoords) + do n = 1_pInt,Ncellnodes ! loop over cell nodes + e = mesh_cellnodeParent(1,n) + localCellnodeID = mesh_cellnodeParent(2,n) + myCoords = 0.0_pReal + do m = 1_pInt,theMesh%elem%nNodes + myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + * theMesh%elem%cellNodeParentNodeWeights(m,localCellnodeID) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(theMesh%elem%cellNodeParentNodeWeights(:,localCellnodeID)) + enddo +!$OMP END PARALLEL DO + +end function mesh_build_cellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipVolumes + use math, only: & + math_volTetrahedron, & + math_areaTriangle + + implicit none + integer(pInt) :: e,t,g,c,i,m,f,n + real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume + + allocate(mesh_ipVolume(theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) + do e = 1_pInt,theMesh%nElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = theMesh%elem%geomType + c = theMesh%elem%cellType + select case (c) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) + + case (2_pInt) ! 2D 4node + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e))) & + + math_areaTriangle(mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e)), & + mesh_cellnode(1:3,mesh_cell(1,i,e))) + + case (3_pInt) ! 3D 4node + forall (i = 1_pInt:theMesh%elem%nIPs) & ! loop over ips=cells in this element + mesh_ipVolume(i,e) = math_volTetrahedron(mesh_cellnode(1:3,mesh_cell(1,i,e)), & + mesh_cellnode(1:3,mesh_cell(2,i,e)), & + mesh_cellnode(1:3,mesh_cell(3,i,e)), & + mesh_cellnode(1:3,mesh_cell(4,i,e))) + + case (4_pInt) ! 3D 8node + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,theMesh%elem%nIPs ! loop over ips=cells in this element + subvolume = 0.0_pReal + forall(f = 1_pInt:FE_NipNeighbors(c), n = 1_pInt:FE_NcellnodesPerCellface(c)) & + subvolume(n,f) = math_volTetrahedron(& + mesh_cellnode(1:3,mesh_cell(FE_cellface( n ,f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n ,m),f,c),i,e)), & + mesh_cellnode(1:3,mesh_cell(FE_cellface(1+mod(n+1,m),f,c),i,e)), & + mesh_ipCoordinates(1:3,i,e)) + mesh_ipVolume(i,e) = 0.5_pReal * sum(subvolume) ! each subvolume is based on four tetrahedrons, altough the face consists of only two triangles -> averaging factor two + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipCoordinates + + implicit none + integer(pInt) :: e,t,g,c,i,n + real(pReal), dimension(3) :: myCoords + + if (.not. allocated(mesh_ipCoordinates)) & + allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,theMesh%nElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) + do e = 1_pInt,theMesh%nElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = theMesh%elem%geomType + c = theMesh%elem%cellType + do i = 1_pInt,theMesh%elem%nIPs + myCoords = 0.0_pReal + do n = 1_pInt,theMesh%elem%nCellnodesPerCell + myCoords = myCoords + mesh_cellnode(1:3,mesh_cell(n,i,e)) + enddo + mesh_ipCoordinates(1:3,i,e) = myCoords / real(theMesh%elem%nCellnodesPerCell,pReal) + enddo + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), intent(in) :: el, & !< element number + ip !< integration point number + real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell + integer(pInt) :: t,g,c,n + + t = mesh_element(2_pInt,el) ! get element type + g = theMesh%elem%geomType + c = theMesh%elem%cellType + mesh_cellCenterCoordinates = 0.0_pReal + do n = 1_pInt,theMesh%elem%nCellnodesPerCell + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates + mesh_cellnode(1:3,mesh_cell(n,ip,el)) + enddo + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(theMesh%elem%nCellnodesPerCell,pReal) + + end function mesh_cellCenterCoordinates + + + + + +!-------------------------------------------------------------------------------------------------- +!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipAreas + use math, only: & + math_crossproduct + + implicit none + integer(pInt) :: e,t,g,c,i,f,n,m + real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals + real(pReal), dimension(3) :: normal + + allocate(mesh_ipArea(theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) + do e = 1_pInt,theMesh%nElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = theMesh%elem%geomType + c = theMesh%elem%cellType + select case (c) + + case (1_pInt,2_pInt) ! 2D 3 or 4 node + do i = 1_pInt,theMesh%elem%nIPs + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal(1) = nodePos(2,2) - nodePos(2,1) ! x_normal = y_connectingVector + normal(2) = -(nodePos(1,2) - nodePos(1,1)) ! y_normal = -x_connectingVector + normal(3) = 0.0_pReal + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (3_pInt) ! 3D 4node + do i = 1_pInt,theMesh%elem%nIPs + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + normal = math_crossproduct(nodePos(1:3,2) - nodePos(1:3,1), & + nodePos(1:3,3) - nodePos(1:3,1)) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) ! ensure unit length of area normal + enddo + enddo + + case (4_pInt) ! 3D 8node + ! for this cell type we get the normal of the quadrilateral face as an average of + ! four normals of triangular subfaces; since the face consists only of two triangles, + ! the sum has to be divided by two; this whole prcedure tries to compensate for + ! probable non-planar cell surfaces + m = FE_NcellnodesPerCellface(c) + do i = 1_pInt,theMesh%elem%nIPs + do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + nodePos(1:3,n) = mesh_cellnode(1:3,mesh_cell(FE_cellface(n,f,c),i,e)) + forall(n = 1_pInt:FE_NcellnodesPerCellface(c)) & + normals(1:3,n) = 0.5_pReal & + * math_crossproduct(nodePos(1:3,1+mod(n ,m)) - nodePos(1:3,n), & + nodePos(1:3,1+mod(n+1,m)) - nodePos(1:3,n)) + normal = 0.5_pReal * sum(normals,2) + mesh_ipArea(f,i,e) = norm2(normal) + mesh_ipAreaNormal(1:3,f,i,e) = normal / norm2(normal) + enddo + enddo + + end select + enddo + !$OMP END PARALLEL DO + +end subroutine mesh_build_ipAreas + + +!-------------------------------------------------------------------------------------------------- +!> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_nodeTwins + + implicit none + integer(pInt) dir, & ! direction of periodicity + node, & + minimumNode, & + maximumNode, & + n1, & + n2 + integer(pInt), dimension(mesh_Nnodes+1) :: minimumNodes, maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes + real(pReal) minCoord, maxCoord, & ! extreme positions in one dimension + tolerance ! tolerance below which positions are assumed identical + real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates + logical, dimension(mesh_Nnodes) :: unpaired + + allocate(mesh_nodeTwins(3,mesh_Nnodes)) + mesh_nodeTwins = 0_pInt + + tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal + + do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z + if (mesh_periodicSurface(dir)) then ! only if periodicity is requested + + + !*** find out which nodes sit on the surface + !*** and have a minimum or maximum position in this dimension + + minimumNodes = 0_pInt + maximumNodes = 0_pInt + minCoord = minval(mesh_node0(dir,:)) + maxCoord = maxval(mesh_node0(dir,:)) + do node = 1_pInt,mesh_Nnodes ! loop through all nodes and find surface nodes + if (abs(mesh_node0(dir,node) - minCoord) <= tolerance) then + minimumNodes(1) = minimumNodes(1) + 1_pInt + minimumNodes(minimumNodes(1)+1_pInt) = node + elseif (abs(mesh_node0(dir,node) - maxCoord) <= tolerance) then + maximumNodes(1) = maximumNodes(1) + 1_pInt + maximumNodes(maximumNodes(1)+1_pInt) = node + endif + enddo + + + !*** find the corresponding node on the other side with the same position in this dimension + + unpaired = .true. + do n1 = 1_pInt,minimumNodes(1) + minimumNode = minimumNodes(n1+1_pInt) + if (unpaired(minimumNode)) then + do n2 = 1_pInt,maximumNodes(1) + maximumNode = maximumNodes(n2+1_pInt) + distance = abs(mesh_node0(:,minimumNode) - mesh_node0(:,maximumNode)) + if (sum(distance) - distance(dir) <= tolerance) then ! minimum possible distance (within tolerance) + mesh_nodeTwins(dir,minimumNode) = maximumNode + mesh_nodeTwins(dir,maximumNode) = minimumNode + unpaired(maximumNode) = .false. ! remember this node, we don't have to look for his partner again + exit + endif + enddo + endif + enddo + + endif + enddo + +end subroutine mesh_build_nodeTwins + + +!-------------------------------------------------------------------------------------------------- +!> @brief get maximum count of shared elements among cpElements and build list of elements shared +!! by each node in mesh. Allocate globals '_maxNsharedElems' and '_sharedElem' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_sharedElems + + implicit none + integer(pint) e, & ! element index + g, & ! element type + node, & ! CP node index + n, & ! node index per element + myDim, & ! dimension index + nodeTwin ! node twin in the specified dimension + integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt), dimension(:), allocatable :: node_seen + + allocate(node_seen(maxval(FE_NmatchingNodes))) + + node_count = 0_pInt + + do e = 1_pInt,theMesh%nElems + g = theMesh%elem%geomType + node_seen = 0_pInt ! reset node duplicates + do n = 1_pInt,FE_NmatchingNodes(g) ! check each node of element + node = mesh_element(4+n,e) + if (all(node_seen /= node)) then + node_count(node) = node_count(node) + 1_pInt ! if FE node not yet encountered -> count it + do myDim = 1_pInt,3_pInt ! check in each dimension... + nodeTwin = mesh_nodeTwins(myDim,node) + if (nodeTwin > 0_pInt) & ! if I am a twin of some node... + node_count(nodeTwin) = node_count(nodeTwin) + 1_pInt ! -> count me again for the twin node + enddo + endif + node_seen(n) = node ! remember this node to be counted already + enddo + enddo + + mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node + + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) + + do e = 1_pInt,theMesh%nElems + g = theMesh%elem%geomType + node_seen = 0_pInt + do n = 1_pInt,FE_NmatchingNodes(g) + node = mesh_element(4_pInt+n,e) + if (all(node_seen /= node)) then + mesh_sharedElem(1,node) = mesh_sharedElem(1,node) + 1_pInt ! count for each node the connected elements + mesh_sharedElem(mesh_sharedElem(1,node)+1_pInt,node) = e ! store the respective element id + do myDim = 1_pInt,3_pInt ! check in each dimension... + nodeTwin = mesh_nodeTwins(myDim,node) + if (nodeTwin > 0_pInt) then ! if i am a twin of some node... + mesh_sharedElem(1,nodeTwin) = mesh_sharedElem(1,nodeTwin) + 1_pInt ! ...count me again for the twin + mesh_sharedElem(mesh_sharedElem(1,nodeTwin)+1,nodeTwin) = e ! store the respective element id + endif + enddo + endif + node_seen(n) = node + enddo + enddo + +end subroutine mesh_build_sharedElems + + +!-------------------------------------------------------------------------------------------------- +!> @brief build up of IP neighborhood, allocate globals '_ipNeighborhood' +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_ipNeighborhood + use math, only: & + math_mul3x3 + + implicit none + integer(pInt) :: myElem, & ! my CP element index + myIP, & + myType, & ! my element type + myFace, & + neighbor, & ! neighor index + neighboringIPkey, & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element) + candidateIP, & + neighboringType, & ! element type of neighbor + NlinkedNodes, & ! number of linked nodes + twin_of_linkedNode, & ! node twin of a specific linkedNode + NmatchingNodes, & ! number of matching nodes + dir, & ! direction of periodicity + matchingElem, & ! CP elem number of matching element + matchingFace, & ! face ID of matching element + a, anchor, & + neighboringIP, & + neighboringElem, & + pointingToMe + integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & + linkedNodes = 0_pInt, & + matchingNodes + logical checkTwins + + allocate(mesh_ipNeighborhood(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems)) + mesh_ipNeighborhood = 0_pInt + + + do myElem = 1_pInt,theMesh%nElems ! loop over cpElems + myType = theMesh%elem%geomType + do myIP = 1_pInt,theMesh%elem%nIPs + + do neighbor = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP + neighboringIPkey = theMesh%elem%IPneighbor(neighbor,myIP) + + !*** if the key is positive, the neighbor is inside the element + !*** that means, we have already found our neighboring IP + + if (neighboringIPkey > 0_pInt) then + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey + + + !*** if the key is negative, the neighbor resides in a neighboring element + !*** that means, we have to look through the face indicated by the key and see which element is behind that face + + elseif (neighboringIPkey < 0_pInt) then ! neighboring element's IP + myFace = -neighboringIPkey + call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match + if (matchingElem > 0_pInt) then ! found match? + neighboringType = theMesh%elem%geomType + + !*** trivial solution if neighbor has only one IP + + if (theMesh%elem%nIPs == 1_pInt) then + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt + cycle + endif + + !*** find those nodes which build the link to the neighbor + + NlinkedNodes = 0_pInt + linkedNodes = 0_pInt + do a = 1_pInt,theMesh%elem%maxNnodeAtIP + anchor = theMesh%elem%NnodeAtIP(a,myIP) + if (anchor /= 0_pInt) then ! valid anchor node + if (any(FE_face(:,myFace,myType) == anchor)) then ! ip anchor sits on face? + NlinkedNodes = NlinkedNodes + 1_pInt + linkedNodes(NlinkedNodes) = mesh_element(4_pInt+anchor,myElem) ! CP id of anchor node + else ! something went wrong with the linkage, since not all anchors sit on my face + NlinkedNodes = 0_pInt + linkedNodes = 0_pInt + exit + endif + endif + enddo + + !*** loop through the ips of my neighbor + !*** and try to find an ip with matching nodes + !*** also try to match with node twins + + checkCandidateIP: do candidateIP = 1_pInt,theMesh%elem%nIPs + NmatchingNodes = 0_pInt + matchingNodes = 0_pInt + do a = 1_pInt,theMesh%elem%maxNnodeAtIP + anchor = theMesh%elem%NnodeAtIP(a,candidateIP) + if (anchor /= 0_pInt) then ! valid anchor node + if (any(FE_face(:,matchingFace,neighboringType) == anchor)) then ! sits on matching face? + NmatchingNodes = NmatchingNodes + 1_pInt + matchingNodes(NmatchingNodes) = mesh_element(4+anchor,matchingElem) ! CP id of neighbor's anchor node + else ! no matching, because not all nodes sit on the matching face + NmatchingNodes = 0_pInt + matchingNodes = 0_pInt + exit + endif + endif + enddo + + if (NmatchingNodes /= NlinkedNodes) & ! this ip has wrong count of anchors on face + cycle checkCandidateIP + + !*** check "normal" nodes whether they match or not + + checkTwins = .false. + do a = 1_pInt,NlinkedNodes + if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode + checkTwins = .true. + exit ! no need to search further + endif + enddo + + !*** if no match found, then also check node twins + + if(checkTwins) then + dir = int(maxloc(abs(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem)),1),pInt) ! check for twins only in direction of the surface normal + do a = 1_pInt,NlinkedNodes + twin_of_linkedNode = mesh_nodeTwins(dir,linkedNodes(a)) + if (twin_of_linkedNode == 0_pInt .or. & ! twin of linkedNode does not exist... + all(matchingNodes /= twin_of_linkedNode)) then ! ... or it does not match any matchingNode + cycle checkCandidateIP ! ... then check next candidateIP + endif + enddo + endif + + !*** we found a match !!! + + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem + mesh_ipNeighborhood(2,neighbor,myIP,myElem) = candidateIP + exit checkCandidateIP + enddo checkCandidateIP + endif ! end of valid external matching + endif ! end of internal/external matching + enddo + enddo + enddo + do myElem = 1_pInt,theMesh%nElems ! loop over cpElems + myType = theMesh%elem%geomType + do myIP = 1_pInt,theMesh%elem%nIPs + do neighbor = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! loop over neighbors of IP + neighboringElem = mesh_ipNeighborhood(1,neighbor,myIP,myElem) + neighboringIP = mesh_ipNeighborhood(2,neighbor,myIP,myElem) + if (neighboringElem > 0_pInt .and. neighboringIP > 0_pInt) then ! if neighbor exists ... + neighboringType = theMesh%elem%geomType + do pointingToMe = 1_pInt,FE_NipNeighbors(theMesh%elem%cellType) ! find neighboring index that points from my neighbor to myself + if ( myElem == mesh_ipNeighborhood(1,pointingToMe,neighboringIP,neighboringElem) & + .and. myIP == mesh_ipNeighborhood(2,pointingToMe,neighboringIP,neighboringElem)) then ! possible candidate + if (math_mul3x3(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem),& + mesh_ipAreaNormal(1:3,pointingToMe,neighboringIP,neighboringElem)) < 0.0_pReal) then ! area normals have opposite orientation (we have to check that because of special case for single element with two ips and periodicity. In this case the neighbor is identical in two different directions.) + mesh_ipNeighborhood(3,neighbor,myIP,myElem) = pointingToMe ! found match + exit ! so no need to search further + endif + endif + enddo + endif + enddo + enddo + enddo + + contains + + !-------------------------------------------------------------------------------------------------- +!> @brief find face-matching element of same type +!-------------------------------------------------------------------------------------------------- +subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) + +implicit none +integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID + matchingFace ! matching face ID +integer(pInt), intent(in) :: face, & ! face ID + elem ! CP elem ID +integer(pInt), dimension(FE_NmatchingNodesPerFace(face,theMesh%elem%geomType)) :: & + myFaceNodes ! global node ids on my face +integer(pInt) :: myType, & + candidateType, & + candidateElem, & + candidateFace, & + candidateFaceNode, & + minNsharedElems, & + NsharedElems, & + lonelyNode = 0_pInt, & + i, & + n, & + dir ! periodicity direction +integer(pInt), dimension(:), allocatable :: element_seen +logical checkTwins + +matchingElem = 0_pInt +matchingFace = 0_pInt +minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case +myType =theMesh%elem%geomType + +do n = 1_pInt,FE_NmatchingNodesPerFace(face,myType) ! loop over nodes on face + myFaceNodes(n) = mesh_element(4_pInt+FE_face(n,face,myType),elem) ! CP id of face node + NsharedElems = mesh_sharedElem(1_pInt,myFaceNodes(n)) ! figure # shared elements for this node + if (NsharedElems < minNsharedElems) then + minNsharedElems = NsharedElems ! remember min # shared elems + lonelyNode = n ! remember most lonely node + endif +enddo + +allocate(element_seen(minNsharedElems)) +element_seen = 0_pInt + +checkCandidate: do i = 1_pInt,minNsharedElems ! iterate over lonelyNode's shared elements + candidateElem = mesh_sharedElem(1_pInt+i,myFaceNodes(lonelyNode)) ! present candidate elem + if (all(element_seen /= candidateElem)) then ! element seen for the first time? + element_seen(i) = candidateElem + candidateType = theMesh%elem%geomType +checkCandidateFace: do candidateFace = 1_pInt,FE_maxNipNeighbors ! check each face of candidate + if (FE_NmatchingNodesPerFace(candidateFace,candidateType) & + /= FE_NmatchingNodesPerFace(face,myType) & ! incompatible face + .or. (candidateElem == elem .and. candidateFace == face)) then ! this is my face + cycle checkCandidateFace + endif + checkTwins = .false. + do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4_pInt+FE_face(n,candidateFace,candidateType),candidateElem) + if (all(myFaceNodes /= candidateFaceNode)) then ! candidate node does not match any of my face nodes + checkTwins = .true. ! perhaps the twin nodes do match + exit + endif + enddo + if(checkTwins) then +checkCandidateFaceTwins: do dir = 1_pInt,3_pInt + do n = 1_pInt,FE_NmatchingNodesPerFace(candidateFace,candidateType) ! loop through nodes on face + candidateFaceNode = mesh_element(4+FE_face(n,candidateFace,candidateType),candidateElem) + if (all(myFaceNodes /= mesh_nodeTwins(dir,candidateFaceNode))) then ! node twin does not match either + if (dir == 3_pInt) then + cycle checkCandidateFace + else + cycle checkCandidateFaceTwins ! try twins in next dimension + endif + endif + enddo + exit checkCandidateFaceTwins + enddo checkCandidateFaceTwins + endif + matchingFace = candidateFace + matchingElem = candidateElem + exit checkCandidate ! found my matching candidate + enddo checkCandidateFace + endif +enddo checkCandidate + +end subroutine mesh_faceMatch + +end subroutine mesh_build_ipNeighborhood + + +!-------------------------------------------------------------------------------------------------- +!> @brief mapping of FE element types to internal representation +!-------------------------------------------------------------------------------------------------- +integer(pInt) function FE_mapElemtype(what) + use IO, only: IO_lc, IO_error + + implicit none + character(len=*), intent(in) :: what + + select case (IO_lc(what)) + case ( '6') + FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle + case ( '155', & + '125', & + '128') + FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) + case ( '11') + FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain + case ( '27') + FE_mapElemtype = 4_pInt ! Plane Strain, Eight-node Distorted Quadrilateral + case ( '54') + FE_mapElemtype = 5_pInt ! Plane Strain, Eight-node Distorted Quadrilateral with reduced integration + case ( '134') + FE_mapElemtype = 6_pInt ! Three-dimensional Four-node Tetrahedron + case ( '157') + FE_mapElemtype = 7_pInt ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations + case ( '127') + FE_mapElemtype = 8_pInt ! Three-dimensional Ten-node Tetrahedron + case ( '136') + FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral + case ( '117', & + '123') + FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration + case ( '7') + FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick + case ( '57') + FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration + case ( '21') + FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral + case default + call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) + end select + +end function FE_mapElemtype + + +!-------------------------------------------------------------------------------------------------- +!> @brief get properties of different types of finite elements +!> @details assign globals FE_cellface +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_FEdata + + implicit none + integer(pInt) :: me + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + + ! *** FE_cellface *** + me = 0_pInt + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 3node, VTK_TRIANGLE (5) + reshape(int([& + 2,3, & + 3,1, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 2D 4node, VTK_QUAD (9) + reshape(int([& + 2,3, & + 4,1, & + 3,4, & + 1,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 4node, VTK_TETRA (10) + reshape(int([& + 1,3,2, & + 1,2,4, & + 2,3,4, & + 1,4,3 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + me = me + 1_pInt + FE_cellface(1:FE_NcellnodesPerCellface(me),1:FE_NipNeighbors(me),me) = & ! 3D 8node, VTK_HEXAHEDRON (12) + reshape(int([& + 2,3,7,6, & + 4,1,5,8, & + 3,4,8,7, & + 1,2,6,5, & + 5,6,7,8, & + 1,4,3,2 & + ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) + + +end subroutine mesh_build_FEdata + + +!-------------------------------------------------------------------------------------------------- +!> @brief Gives the FE to CP ID mapping by binary search through lookup array +!! valid questions (what) are 'elem', 'node' +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_FEasCP(what,myID) + use IO, only: & + IO_lc + + implicit none + character(len=*), intent(in) :: what + integer(pInt), intent(in) :: myID + + integer(pInt), dimension(:,:), pointer :: lookupMap + integer(pInt) :: lower,upper,center + + mesh_FEasCP = 0_pInt + select case(IO_lc(what(1:4))) + case('elem') + lookupMap => mesh_mapFEtoCPelem + case('node') + lookupMap => mesh_mapFEtoCPnode + case default + return + endselect + + lower = 1_pInt + upper = int(size(lookupMap,2_pInt),pInt) + + if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? + mesh_FEasCP = lookupMap(2_pInt,lower) + return + elseif (lookupMap(1_pInt,upper) == myID) then + mesh_FEasCP = lookupMap(2_pInt,upper) + return + endif + binarySearch: do while (upper-lower > 1_pInt) + center = (lower+upper)/2_pInt + if (lookupMap(1_pInt,center) < myID) then + lower = center + elseif (lookupMap(1_pInt,center) > myID) then + upper = center + else + mesh_FEasCP = lookupMap(2_pInt,center) + exit + endif + enddo binarySearch + +end function mesh_FEasCP + +end module mesh diff --git a/src/numerics.f90 b/src/numerics.f90 index 9e585dda7..1678d0c48 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -177,13 +177,8 @@ subroutine numerics_init #include use petscsys #endif -#if !defined(Marc4DAMASK) -!$ use OMP_LIB, only: omp_set_num_threads ! Standard conforming module +!$ use OMP_LIB, only: omp_set_num_threads implicit none -#else - implicit none -!$ include "omp_lib.h" ! MSC.Marc includes this file on !its own, avoid conflict with the OMP_LIB module -#endif integer(pInt), parameter :: FILEUNIT = 300_pInt !$ integer :: gotDAMASK_NUM_THREADS = 1 integer :: i, ierr ! no pInt diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index f095caeeb..76b9339fa 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -309,9 +309,7 @@ use IO, only: IO_read, & use debug, only: debug_level, & debug_constitutive, & debug_levelBasic -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & - mesh_maxNipNeighbors +use mesh, only: theMesh use material, only: phase_plasticity, & homogenization_maxNgrains, & phase_plasticityInstance, & @@ -430,6 +428,7 @@ allocate(minDipoleHeightPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), s allocate(peierlsStressPerSlipFamily(lattice_maxNslipFamily,2,maxNinstances), source=0.0_pReal) allocate(nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstances), source=0.0_pReal) + rewind(fileUnit) phase = 0_pInt do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= MATERIAL_partPhase) ! wind forward to @@ -697,23 +696,23 @@ allocate(forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstances), allocate(forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstances), source=0.0_pReal) allocate(lattice2slip(1:3, 1:3, maxTotalNslip,maxNinstances), source=0.0_pReal) -allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(sourceProbability(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=2.0_pReal) -allocate(rhoDotFluxOutput(maxTotalNslip,8,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotFluxOutput(maxTotalNslip,8,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotMultiplicationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotMultiplicationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotSingle2DipoleGlideOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotSingle2DipoleGlideOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotAthermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotAthermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), & +allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), & +allocate(compatibility(2,maxTotalNslip,maxTotalNslip,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) allocate(peierlsStress(maxTotalNslip,2,maxNinstances), source=0.0_pReal) allocate(colinearSystem(maxTotalNslip,maxNinstances), source=0_pInt) @@ -798,7 +797,6 @@ allocate(nonSchmidProjection(3,3,4,maxTotalNslip,maxNinstances), - plasticState(phase)%nonlocal = .true. call material_allocatePlasticState(phase,NofMyPhase,sizeState,sizeDotState,sizeDeltaState, & totalNslip(instance),0_pInt,0_pInt) @@ -999,10 +997,8 @@ use IO, only: IO_error use lattice, only: lattice_maxNslipFamily use math, only: math_sampleGaussVar use mesh, only: mesh_ipVolume, & - mesh_NcpElems, & - mesh_element, & - FE_Nips, & - FE_geomtype + theMesh, & + mesh_element use material, only: material_phase, & phase_plasticityInstance, & plasticState, & @@ -1041,8 +1037,8 @@ do instance = 1_pInt,maxNinstances minimumIpVolume = huge(1.0_pReal) totalVolume = 0.0_pReal - do e = 1_pInt,mesh_NcpElems - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + do e = 1_pInt,theMesh%nElems + do i = 1_pInt,theMesh%elem%nIPs if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then totalVolume = totalVolume + mesh_ipVolume(i,e) @@ -1057,8 +1053,8 @@ do instance = 1_pInt,maxNinstances meanDensity = 0.0_pReal do while(meanDensity < rhoSglRandom(instance)) call random_number(rnd) - e = nint(rnd(1)*real(mesh_NcpElems,pReal)+0.5_pReal,pInt) - i = nint(rnd(2)*real(FE_Nips(FE_geomtype(mesh_element(2,e))),pReal)+0.5_pReal,pInt) + e = nint(rnd(1)*real(theMesh%nElems,pReal)+0.5_pReal,pInt) + i = nint(rnd(2)*real(theMesh%elem%nIPs,pReal)+0.5_pReal,pInt) if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then s = nint(rnd(3)*real(ns,pReal)+0.5_pReal,pInt) @@ -1071,8 +1067,8 @@ do instance = 1_pInt,maxNinstances enddo ! homogeneous distribution of density with some noise else - do e = 1_pInt,mesh_NcpElems - do i = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,e))) + do e = 1_pInt,theMesh%nElems + do i = 1_pInt,theMesh%elem%nIPs if (PLASTICITY_NONLOCAL_ID == phase_plasticity(material_phase(1,i,e)) & .and. instance == phase_plasticityInstance(material_phase(1,i,e))) then do f = 1_pInt,lattice_maxNslipFamily @@ -1154,16 +1150,13 @@ use debug, only: & debug_i, & debug_e use mesh, only: & + theMesh, & mesh_element, & mesh_ipNeighborhood, & mesh_ipCoordinates, & mesh_ipVolume, & mesh_ipAreaNormal, & - mesh_ipArea, & - FE_NipNeighbors, & - mesh_maxNipNeighbors, & - FE_geomtype, & - FE_celltype + mesh_ipArea use material, only: & material_phase, & phase_localPlasticity, & @@ -1223,7 +1216,7 @@ real(pReal), dimension(3,3) :: invFe, & ! inverse of elast invFp, & ! inverse of plastic deformation gradient connections, & invConnections -real(pReal), dimension(3,mesh_maxNipNeighbors) :: & +real(pReal), dimension(3,theMesh%elem%nIPneighbors) :: & connection_latticeConf real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & rhoExcess @@ -1234,7 +1227,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))), & totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el)))) :: & myInteractionMatrix ! corrected slip interaction matrix -real(pReal), dimension(2,maxval(totalNslip),mesh_maxNipNeighbors) :: & +real(pReal), dimension(2,maxval(totalNslip),theMesh%elem%nIPneighbors) :: & neighbor_rhoExcess, & ! excess density at neighboring material point neighbor_rhoTotal ! total density at neighboring material point real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1_pInt,ip,el))),2) :: & @@ -1309,7 +1302,7 @@ if (.not. phase_localPlasticity(ph) .and. shortRangeStressCorrection(instance)) nRealNeighbors = 0_pInt neighbor_rhoTotal = 0.0_pReal - do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) + do n = 1_pInt,theMesh%elem%nIPneighbors neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) np = phaseAt(1,neighbor_ip,neighbor_el) @@ -1995,16 +1988,12 @@ use math, only: math_mul6x6, & math_det33, & math_transpose33, & pi -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & +use mesh, only: theMesh, & mesh_element, & mesh_ipNeighborhood, & mesh_ipVolume, & mesh_ipArea, & - mesh_ipAreaNormal, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype + mesh_ipAreaNormal use material, only: homogenization_maxNgrains, & material_phase, & phase_plasticityInstance, & @@ -2030,9 +2019,9 @@ integer(pInt), intent(in) :: ip, & real(pReal), intent(in) :: Temperature, & !< temperature timestep !< substepped crystallite time increment real(pReal), dimension(6), intent(in) :: Tstar_v !< current 2nd Piola-Kirchhoff stress in Mandel notation -real(pReal), dimension(homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & subfrac !< fraction of timestep at the beginning of the substepped crystallite time increment -real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe, & !< elastic deformation gradient Fp !< plastic deformation gradient @@ -2311,8 +2300,8 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then my_Fe = Fe(1:3,1:3,1_pInt,ip,el) my_F = math_mul33x33(my_Fe, Fp(1:3,1:3,1_pInt,ip,el)) - do n = 1_pInt,FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) ! loop through my neighbors -! write(6,*) 'c' + do n = 1_pInt,theMesh%elem%nIPneighbors + neighbor_el = mesh_ipNeighborhood(1,n,ip,el) neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) neighbor_n = mesh_ipNeighborhood(3,n,ip,el) @@ -2611,11 +2600,7 @@ use material, only: material_phase, & homogenization_maxNgrains use mesh, only: mesh_element, & mesh_ipNeighborhood, & - mesh_maxNips, & - mesh_NcpElems, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype + theMesh use lattice, only: lattice_sn, & lattice_sd, & lattice_qDisorientation @@ -2625,7 +2610,7 @@ implicit none !* input variables integer(pInt), intent(in) :: i, & ! ip index e ! element index -real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & +real(pReal), dimension(4,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & orientation ! crystal orientation in quaternions !* local variables @@ -2644,7 +2629,7 @@ integer(pInt) Nneighbors, & real(pReal), dimension(4) :: absoluteMisorientation ! absolute misorientation (without symmetry) between me and my neighbor real(pReal), dimension(2,totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& totalNslip(phase_plasticityInstance(material_phase(1,i,e))),& - FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e))))) :: & + theMesh%elem%nIPneighbors) :: & my_compatibility ! my_compatibility for current element and ip real(pReal), dimension(3,totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) :: & slipNormal, & @@ -2656,7 +2641,7 @@ logical, dimension(totalNslip(phase_plasticityInstance(material_phase(1,i,e)))) belowThreshold -Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,e)))) +Nneighbors = theMesh%elem%nIPneighbors ph = material_phase(1,i,e) textureID = material_texture(1,i,e) instance = phase_plasticityInstance(ph) @@ -2771,8 +2756,7 @@ function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) math_mul33x33, & pi use mesh, only: & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & homogenization_maxNgrains, & material_phase, & @@ -2790,7 +2774,7 @@ function plastic_nonlocal_postResults(Tstar_v,Fe,ip,el) implicit none real(pReal), dimension(6), intent(in) :: & Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), dimension(3,3,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & + real(pReal), dimension(3,3,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), intent(in) :: & Fe !< elastic deformation gradient integer(pInt), intent(in) :: & ip, & !< integration point @@ -2900,8 +2884,8 @@ forall (s = 1_pInt:ns) & lattice_sn(1:3,slipSystemLattice(s,instance),ph)) - outputsLoop: do o = 1_pInt,size(param(instance)%outputID) - select case(param(instance)%outputID(o)) +outputsLoop: do o = 1_pInt,plastic_nonlocal_Noutput(instance) + select case(plastic_nonlocal_outputID(o,instance)) case (rho_sgl_edge_pos_mobile_ID) plastic_nonlocal_postResults(cs+1_pInt:cs+ns) = rhoSgl(1:ns,1)