From 558a610df1dce05e7a132b6cdf00cb1aec8ef045 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 09:49:21 +0100 Subject: [PATCH 01/92] underscore for separation --- src/CMakeLists.txt | 2 +- src/{meshFEM.f90 => mesh_FEM.f90} | 0 2 files changed, 1 insertion(+), 1 deletion(-) rename src/{meshFEM.f90 => mesh_FEM.f90} (100%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 23c7a5643..9e8926d0a 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -66,7 +66,7 @@ elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") add_dependencies(FEZoo DAMASK_MATH) list(APPEND OBJECTFILES $) - add_library(MESH OBJECT "meshFEM.f90") + add_library(MESH OBJECT "mesh_FEM.f90") add_dependencies(MESH FEZoo) list(APPEND OBJECTFILES $) endif() diff --git a/src/meshFEM.f90 b/src/mesh_FEM.f90 similarity index 100% rename from src/meshFEM.f90 rename to src/mesh_FEM.f90 From 612fa31188c68882e691f801b5dfc95382b60393 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 09:52:18 +0100 Subject: [PATCH 02/92] preparing solver-specific mesh functionality --- src/CMakeLists.txt | 2 +- src/commercialFEM_fileList.f90 | 7 +- src/{mesh.f90 => mesh_abaqus.f90} | 0 src/mesh_grid.f90 | 4280 +++++++++++++++++++++++++++++ src/mesh_marc.f90 | 4280 +++++++++++++++++++++++++++++ 5 files changed, 8567 insertions(+), 2 deletions(-) rename src/{mesh.f90 => mesh_abaqus.f90} (100%) create mode 100644 src/mesh_grid.f90 create mode 100644 src/mesh_marc.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9e8926d0a..3818130da 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -59,7 +59,7 @@ 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_library(MESH OBJECT "mesh_grid.f90") add_dependencies(MESH DAMASK_MATH) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 4feb52bed..a7a61c2f7 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -12,7 +12,12 @@ #endif #include "math.f90" #include "FEsolving.f90" -#include "mesh.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/mesh.f90 b/src/mesh_abaqus.f90 similarity index 100% rename from src/mesh.f90 rename to src/mesh_abaqus.f90 diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 new file mode 100644 index 000000000..e55165d51 --- /dev/null +++ b/src/mesh_grid.f90 @@ -0,0 +1,4280 @@ +!-------------------------------------------------------------------------------------------------- +!> @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 + + implicit none + private + integer(pInt), public, protected :: & + mesh_NcpElems, & !< total number of CP elements in local mesh + 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_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 !!!!! + integer(pInt), public, protected :: & + mesh_maxNips, & !< max number of IPs in any CP element + mesh_maxNcellnodes !< max number of cell nodes in any CP element +!!!! BEGIN DEPRECATED !!!!! + + 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_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) + + 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) + +#if defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), private :: & + mesh_maxNelemInSet, & + mesh_Nmaterials +#endif + + integer(pInt), dimension(2), private :: & + mesh_maxValStateVar = 0_pInt + +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_nodesAtIP, & !< map IP index to node indices in a specific type of element + FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element + FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry + FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell + + real(pReal), dimension(:,:,:), allocatable, private :: & + FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes + + integer(pInt), dimension(:,:,:,:), allocatable, private :: & + FE_subNodeOnIPFace + +! 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_maxNnodes = 20_pInt, & + FE_maxNips = 27_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_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 3, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 3, & ! element 54 (2D 8node 4ip) + 5, & ! element 134 (3D 4node 1ip) + 6, & ! element 157 (3D 5node 4ip) + 6, & ! element 127 (3D 10node 4ip) + 7, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 9, & ! element 7 (3D 8node 8ip) + 9, & ! element 57 (3D 20node 8ip) + 10 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 4, & ! element 136 (3D 6node 6ip) + 4, & ! element 117 (3D 8node 1ip) + 4, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type + int([ & + 2, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 3, & ! element 127 (3D 10node 4ip) + 3, & ! element 136 (3D 6node 6ip) + 3, & ! element 117 (3D 8node 1ip) + 3, & ! element 7 (3D 8node 8ip) + 3 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element + int([ & + 3, & ! element 6 (2D 3node 1ip) + 6, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 8, & ! element 27 (2D 8node 9ip) + 8, & ! element 54 (2D 8node 4ip) + 4, & ! element 134 (3D 4node 1ip) + 5, & ! element 157 (3D 5node 4ip) + 10, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 20, & ! element 57 (3D 20node 8ip) + 20 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: 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_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type + int([ & + 3, & ! element 6 (2D 3node 1ip) + 7, & ! element 125 (2D 6node 3ip) + 9, & ! element 11 (2D 4node 4ip) + 16, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 15, & ! element 127 (3D 10node 4ip) + 21, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 27, & ! element 7 (3D 8node 8ip) + 64 & ! element 21 (3D 20node 27ip) + ],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_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element + int([ & + 1, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 9, & ! element 27 (2D 8node 9ip) + 1, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 1, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 27 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, public :: 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(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) + 1, & ! element 125 (2D 6node 3ip) + 1, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 1, & ! element 127 (3D 10node 4ip) + 1, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 1, & ! element 7 (3D 8node 8ip) + 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 + mesh_NelemSets + character(len=64), dimension(:), allocatable, private :: & + mesh_nameElemSet, & !< names of elementSet + mesh_nameMaterial, & !< names of material in solid section + mesh_mapMaterial !< name of elementSet for material + 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] +#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, & + mesh_build_cellnodes, & + 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, & + mesh_abaqus_map_elementSets, & + mesh_abaqus_map_materials, & + mesh_abaqus_count_cpElements, & + mesh_abaqus_map_elements, & + mesh_abaqus_map_nodes, & + mesh_abaqus_build_nodes, & + mesh_abaqus_count_cpSizes, & + mesh_abaqus_build_elements +#endif + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @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 + use debug, only: & + debug_e, & + debug_i, & + debug_level, & + debug_mesh, & + debug_levelBasic + use numerics, only: & + usePingPong, & + numerics_unitlength, & + worldrank + use FEsolving, only: & +#ifndef Spectral + modelName, & + calcMode, & +#endif + 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) + call mesh_abaqus_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_abaqus_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_abaqus_count_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) + call mesh_abaqus_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_abaqus_map_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) + call mesh_abaqus_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_abaqus_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_abaqus_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_abaqus_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_abaqus_count_cpSizes(FILEUNIT) + 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) + if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + 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) + 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,:) +!!!!!!!!!!!!!!!!!!!!!!!! + +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' +!-------------------------------------------------------------------------------------------------- +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 +#endif + +!-------------------------------------------------------------------------------------------------- +!> @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(mesh_maxNcellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,t,g,c,n,i, & + matchingNodeID, & + localCellnodeID + + allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) + allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) + +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + mesh_Ncells = 0_pInt + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + localCellnode2globalCellnode = 0_pInt + mesh_Ncells = mesh_Ncells + FE_Nips(g) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + localCellnodeID = FE_cell(n,i,g) + if (localCellnodeID <= FE_NmatchingNodes(g)) 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,t,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) + do n = 1_pInt,Ncellnodes ! loop over cell nodes + e = mesh_cellnodeParent(1,n) + localCellnodeID = mesh_cellnodeParent(2,n) + t = mesh_element(2,e) ! get element type + myCoords = 0.0_pReal + do m = 1_pInt,FE_Nnodes(t) + myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + 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 + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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,FE_Nips(g) ! 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,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,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=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) :: t,g,c,n + + t = mesh_element(2_pInt,el) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + 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 + + +#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 + + +!-------------------------------------------------------------------------------------------------- +!> @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(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt,2_pInt) ! 2D 3 or 4 node + do i = 1_pInt,FE_Nips(g) ! 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,FE_Nips(g) ! 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,FE_Nips(g) ! 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 + +#ifndef Spectral +!-------------------------------------------------------------------------------------------------- +!> @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,mesh_NcpElems + g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + 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,mesh_NcpElems + g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + 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,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) + mesh_ipNeighborhood = 0_pInt + + + do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType + do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + + do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) + + !*** 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 = FE_geomtype(mesh_element(2,matchingElem)) + + !*** trivial solution if neighbor has only one IP + + if (FE_Nips(neighboringType) == 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,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face + anchor = FE_nodesAtIP(a,myIP,myType) + 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,FE_Nips(neighboringType) + NmatchingNodes = 0_pInt + matchingNodes = 0_pInt + do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip + anchor = FE_nodesAtIP(a,candidateIP,neighboringType) + 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,mesh_NcpElems ! loop over cpElems + myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType + do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! 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 = FE_geomtype(mesh_element(2,neighboringElem)) + do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! 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 + +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 + + +!-------------------------------------------------------------------------------------------------- +!> @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,FE_geomtype(mesh_element(2,elem)))) :: & + 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 = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType + +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 = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate +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 + + +!-------------------------------------------------------------------------------------------------- +!> @brief get properties of different types of finite elements +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_FEdata + + implicit none + integer(pInt) :: me + allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + + + !*** fill FE_nodesAtIP with data *** + + me = 0_pInt + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + 1,2,3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, & + 2, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, & + 2, & + 4, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + 1,2,3,4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 1, & + 2, & + 3, & + 4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + 1,2,3,4,5,6,7,8 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + 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),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + + ! *** 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. + me = 0_pInt + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + -2,-3,-1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + -1,-2,-3,-4 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + -3,-5,-4,-2,-6,-1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cell *** + me = 0_pInt + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + 1,2,3 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + 1, 2, 3, 4 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + 1, 2, 3, 4, 5, 6, 7, 8 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cellnodeParentnodeWeights *** + ! center of gravity of the weighted nodes gives the position of the cell node. + ! fill with 0. + ! 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 + me = 0_pInt + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) + reshape(real([& + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + + + ! *** 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 returns global variable mesh_Ncellnodes +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_Ncellnodes() + + implicit none + + mesh_get_Ncellnodes = mesh_Ncellnodes + +end function mesh_get_Ncellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @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 + + +end module mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 new file mode 100644 index 000000000..e55165d51 --- /dev/null +++ b/src/mesh_marc.f90 @@ -0,0 +1,4280 @@ +!-------------------------------------------------------------------------------------------------- +!> @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 + + implicit none + private + integer(pInt), public, protected :: & + mesh_NcpElems, & !< total number of CP elements in local mesh + 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_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 !!!!! + integer(pInt), public, protected :: & + mesh_maxNips, & !< max number of IPs in any CP element + mesh_maxNcellnodes !< max number of cell nodes in any CP element +!!!! BEGIN DEPRECATED !!!!! + + 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_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) + + 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) + +#if defined(Marc4DAMASK) || defined(Abaqus) + integer(pInt), private :: & + mesh_maxNelemInSet, & + mesh_Nmaterials +#endif + + integer(pInt), dimension(2), private :: & + mesh_maxValStateVar = 0_pInt + +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_nodesAtIP, & !< map IP index to node indices in a specific type of element + FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element + FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry + FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell + + real(pReal), dimension(:,:,:), allocatable, private :: & + FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes + + integer(pInt), dimension(:,:,:,:), allocatable, private :: & + FE_subNodeOnIPFace + +! 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_maxNnodes = 20_pInt, & + FE_maxNips = 27_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_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 3, & ! element 11 (2D 4node 4ip) + 4, & ! element 27 (2D 8node 9ip) + 3, & ! element 54 (2D 8node 4ip) + 5, & ! element 134 (3D 4node 1ip) + 6, & ! element 157 (3D 5node 4ip) + 6, & ! element 127 (3D 10node 4ip) + 7, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 9, & ! element 7 (3D 8node 8ip) + 9, & ! element 57 (3D 20node 8ip) + 10 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type + int([ & + 1, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 4, & ! element 136 (3D 6node 6ip) + 4, & ! element 117 (3D 8node 1ip) + 4, & ! element 7 (3D 8node 8ip) + 4 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type + int([ & + 2, & ! element 6 (2D 3node 1ip) + 2, & ! element 125 (2D 6node 3ip) + 2, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 3, & ! element 134 (3D 4node 1ip) + 3, & ! element 127 (3D 10node 4ip) + 3, & ! element 136 (3D 6node 6ip) + 3, & ! element 117 (3D 8node 1ip) + 3, & ! element 7 (3D 8node 8ip) + 3 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element + int([ & + 3, & ! element 6 (2D 3node 1ip) + 6, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 8, & ! element 27 (2D 8node 9ip) + 8, & ! element 54 (2D 8node 4ip) + 4, & ! element 134 (3D 4node 1ip) + 5, & ! element 157 (3D 5node 4ip) + 10, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 20, & ! element 57 (3D 20node 8ip) + 20 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: 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_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type + int([ & + 3, & ! element 6 (2D 3node 1ip) + 7, & ! element 125 (2D 6node 3ip) + 9, & ! element 11 (2D 4node 4ip) + 16, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 15, & ! element 127 (3D 10node 4ip) + 21, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 27, & ! element 7 (3D 8node 8ip) + 64 & ! element 21 (3D 20node 27ip) + ],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_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element + int([ & + 1, & ! element 6 (2D 3node 1ip) + 3, & ! element 125 (2D 6node 3ip) + 4, & ! element 11 (2D 4node 4ip) + 9, & ! element 27 (2D 8node 9ip) + 1, & ! element 134 (3D 4node 1ip) + 4, & ! element 127 (3D 10node 4ip) + 6, & ! element 136 (3D 6node 6ip) + 1, & ! element 117 (3D 8node 1ip) + 8, & ! element 7 (3D 8node 8ip) + 27 & ! element 21 (3D 20node 27ip) + ],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, public :: 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(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) + 1, & ! element 125 (2D 6node 3ip) + 1, & ! element 11 (2D 4node 4ip) + 2, & ! element 27 (2D 8node 9ip) + 4, & ! element 134 (3D 4node 1ip) + 1, & ! element 127 (3D 10node 4ip) + 1, & ! element 136 (3D 6node 6ip) + 8, & ! element 117 (3D 8node 1ip) + 1, & ! element 7 (3D 8node 8ip) + 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 + mesh_NelemSets + character(len=64), dimension(:), allocatable, private :: & + mesh_nameElemSet, & !< names of elementSet + mesh_nameMaterial, & !< names of material in solid section + mesh_mapMaterial !< name of elementSet for material + 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] +#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, & + mesh_build_cellnodes, & + 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, & + mesh_abaqus_map_elementSets, & + mesh_abaqus_map_materials, & + mesh_abaqus_count_cpElements, & + mesh_abaqus_map_elements, & + mesh_abaqus_map_nodes, & + mesh_abaqus_build_nodes, & + mesh_abaqus_count_cpSizes, & + mesh_abaqus_build_elements +#endif + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @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 + use debug, only: & + debug_e, & + debug_i, & + debug_level, & + debug_mesh, & + debug_levelBasic + use numerics, only: & + usePingPong, & + numerics_unitlength, & + worldrank + use FEsolving, only: & +#ifndef Spectral + modelName, & + calcMode, & +#endif + 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) + call mesh_abaqus_count_nodesAndElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) + call mesh_abaqus_count_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) + call mesh_abaqus_count_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) + call mesh_abaqus_map_elementSets(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) + call mesh_abaqus_map_materials(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) + call mesh_abaqus_count_cpElements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) + call mesh_abaqus_map_elements(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) + call mesh_abaqus_map_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) + call mesh_abaqus_build_nodes(FILEUNIT) + if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) + call mesh_abaqus_count_cpSizes(FILEUNIT) + 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) + if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) + 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) + 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,:) +!!!!!!!!!!!!!!!!!!!!!!!! + +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' +!-------------------------------------------------------------------------------------------------- +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 +#endif + +!-------------------------------------------------------------------------------------------------- +!> @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(mesh_maxNcellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,t,g,c,n,i, & + matchingNodeID, & + localCellnodeID + + allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) + allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) + +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + mesh_Ncells = 0_pInt + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + localCellnode2globalCellnode = 0_pInt + mesh_Ncells = mesh_Ncells + FE_Nips(g) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + localCellnodeID = FE_cell(n,i,g) + if (localCellnodeID <= FE_NmatchingNodes(g)) 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,t,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) + do n = 1_pInt,Ncellnodes ! loop over cell nodes + e = mesh_cellnodeParent(1,n) + localCellnodeID = mesh_cellnodeParent(2,n) + t = mesh_element(2,e) ! get element type + myCoords = 0.0_pReal + do m = 1_pInt,FE_Nnodes(t) + myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + 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 + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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,FE_Nips(g) ! 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,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,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=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) :: t,g,c,n + + t = mesh_element(2_pInt,el) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + 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 + + +#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 + + +!-------------------------------------------------------------------------------------------------- +!> @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(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt,2_pInt) ! 2D 3 or 4 node + do i = 1_pInt,FE_Nips(g) ! 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,FE_Nips(g) ! 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,FE_Nips(g) ! 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 + +#ifndef Spectral +!-------------------------------------------------------------------------------------------------- +!> @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,mesh_NcpElems + g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + 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,mesh_NcpElems + g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + 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,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) + mesh_ipNeighborhood = 0_pInt + + + do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems + myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType + do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + + do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) + + !*** 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 = FE_geomtype(mesh_element(2,matchingElem)) + + !*** trivial solution if neighbor has only one IP + + if (FE_Nips(neighboringType) == 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,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face + anchor = FE_nodesAtIP(a,myIP,myType) + 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,FE_Nips(neighboringType) + NmatchingNodes = 0_pInt + matchingNodes = 0_pInt + do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip + anchor = FE_nodesAtIP(a,candidateIP,neighboringType) + 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,mesh_NcpElems ! loop over cpElems + myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType + do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! 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 = FE_geomtype(mesh_element(2,neighboringElem)) + do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! 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 + +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 + + +!-------------------------------------------------------------------------------------------------- +!> @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,FE_geomtype(mesh_element(2,elem)))) :: & + 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 = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType + +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 = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate +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 + + +!-------------------------------------------------------------------------------------------------- +!> @brief get properties of different types of finite elements +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!-------------------------------------------------------------------------------------------------- +subroutine mesh_build_FEdata + + implicit none + integer(pInt) :: me + allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) + allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) + allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) + + + !*** fill FE_nodesAtIP with data *** + + me = 0_pInt + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + 1,2,3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, & + 2, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, & + 2, & + 4, & + 3 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + reshape(int([& + 1,0, & + 1,2, & + 2,0, & + 1,4, & + 0,0, & + 2,3, & + 4,0, & + 3,4, & + 3,0 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + 1,2,3,4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + reshape(int([& + 1, & + 2, & + 3, & + 4 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + reshape(int([& + 1, & + 2, & + 3, & + 4, & + 5, & + 6 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + 1,2,3,4,5,6,7,8 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + reshape(int([& + 1, & + 2, & + 4, & + 3, & + 5, & + 6, & + 8, & + 7 & + ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + me = me + 1_pInt + FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + 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),[FE_maxNnodesAtIP(me),FE_Nips(me)]) + + + ! *** 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. + me = 0_pInt + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + -2,-3,-1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 2,-3, 3,-1, & + -2, 1, 3,-1, & + 2,-3,-2, 1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 2,-4, 3,-1, & + -2, 1, 4,-1, & + 4,-4,-3, 1, & + -2, 3,-3, 2 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + -1,-2,-3,-4 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + -3,-5,-4,-2,-6,-1 & + ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cell *** + me = 0_pInt + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) + reshape(int([& + 1,2,3 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) + reshape(int([& + 1, 4, 7, 6, & + 2, 5, 7, 4, & + 3, 6, 7, 5 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) + reshape(int([& + 1, 5, 9, 8, & + 5, 2, 6, 9, & + 8, 9, 7, 4, & + 9, 6, 3, 7 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) + reshape(int([& + 1, 2, 3, 4 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) + reshape(int([& + 1, 2, 3, 4, 5, 6, 7, 8 & + ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + me = me + 1_pInt + FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) + 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) + + + ! *** FE_cellnodeParentnodeWeights *** + ! center of gravity of the weighted nodes gives the position of the cell node. + ! fill with 0. + ! 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 + me = 0_pInt + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) + reshape(real([& + 1, 0, 0, & + 0, 1, 0, & + 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) + reshape(real([& + 1, 0, 0, 0, & + 0, 1, 0, 0, & + 0, 0, 1, 0, & + 0, 0, 0, 1 & + ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + me = me + 1_pInt + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) + 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) + + + + ! *** 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 returns global variable mesh_Ncellnodes +!-------------------------------------------------------------------------------------------------- +integer(pInt) function mesh_get_Ncellnodes() + + implicit none + + mesh_get_Ncellnodes = mesh_Ncellnodes + +end function mesh_get_Ncellnodes + + +!-------------------------------------------------------------------------------------------------- +!> @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 + + +end module mesh From 012759d0360a92ff8b10d1cf4f9740b9f4201a0f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:04:43 +0100 Subject: [PATCH 03/92] remove non-marc specific code --- src/mesh_marc.f90 | 1520 +-------------------------------------------- 1 file changed, 5 insertions(+), 1515 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index e55165d51..b993b43d6 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -62,11 +62,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 @@ -344,19 +342,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 +355,14 @@ 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, & @@ -391,12 +373,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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, & @@ -406,19 +384,9 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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, & @@ -431,19 +399,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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, & - mesh_abaqus_map_elementSets, & - mesh_abaqus_map_materials, & - mesh_abaqus_count_cpElements, & - mesh_abaqus_map_elements, & - mesh_abaqus_map_nodes, & - mesh_abaqus_build_nodes, & - mesh_abaqus_count_cpSizes, & - mesh_abaqus_build_elements -#endif contains @@ -457,22 +412,10 @@ subroutine mesh_init(ip,el) 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,19 +430,12 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral modelName, & calcMode, & -#endif 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 @@ -514,36 +450,6 @@ subroutine mesh_init(ip,el) 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) @@ -572,33 +478,6 @@ subroutine mesh_init(ip,el) 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) - call mesh_abaqus_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_abaqus_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_abaqus_count_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) - call mesh_abaqus_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_abaqus_map_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) - call mesh_abaqus_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_abaqus_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_abaqus_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_abaqus_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_abaqus_count_cpSizes(FILEUNIT) - 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) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) @@ -614,25 +493,16 @@ subroutine mesh_init(ip,el) 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)))) & @@ -642,11 +512,9 @@ subroutine mesh_init(ip,el) 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. @@ -662,7 +530,6 @@ subroutine mesh_init(ip,el) 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' @@ -711,7 +578,6 @@ integer(pInt) function mesh_FEasCP(what,myID) enddo binarySearch end function mesh_FEasCP -#endif !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -953,548 +819,6 @@ 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 !-------------------------------------------------------------------------------------------------- @@ -2105,693 +1429,6 @@ subroutine mesh_marc_build_elements(fileUnit) 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 !-------------------------------------------------------------------------------------------------- @@ -2807,12 +1444,6 @@ use IO, only: & 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 @@ -2820,12 +1451,7 @@ use IO, only: & character(len=300) :: keyword mesh_periodicSurface = .false. -#ifdef Marc4DAMASK keyword = '$damask' -#endif -#ifdef Abaqus - keyword = '**damask' -#endif rewind(fileUnit) do @@ -2849,7 +1475,6 @@ use IO, only: & 610 FORMAT(A300) 620 end subroutine mesh_get_damaskOptions -#endif !-------------------------------------------------------------------------------------------------- @@ -2925,7 +1550,7 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral + !-------------------------------------------------------------------------------------------------- !> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' !-------------------------------------------------------------------------------------------------- @@ -3227,141 +1852,6 @@ subroutine mesh_build_ipNeighborhood 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 !-------------------------------------------------------------------------------------------------- From f6cd37f11adadd55175a094c8c987eac517228c4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:12:27 +0100 Subject: [PATCH 04/92] removing non-grid(spectral) related functionality --- src/mesh_grid.f90 | 2001 +-------------------------------------------- 1 file changed, 7 insertions(+), 1994 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index e55165d51..7cf7a1e64 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -62,12 +62,6 @@ 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 @@ -344,7 +338,7 @@ 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 :: & @@ -356,31 +350,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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 - mesh_NelemSets - character(len=64), dimension(:), allocatable, private :: & - mesh_nameElemSet, & !< names of elementSet - mesh_nameMaterial, & !< names of material in solid section - mesh_mapMaterial !< name of elementSet for material - 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] -#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, & @@ -391,59 +360,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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, & - mesh_abaqus_map_elementSets, & - mesh_abaqus_map_materials, & - mesh_abaqus_count_cpElements, & - mesh_abaqus_map_elements, & - mesh_abaqus_map_nodes, & - mesh_abaqus_build_nodes, & - mesh_abaqus_count_cpSizes, & - mesh_abaqus_build_elements -#endif + contains @@ -458,21 +392,14 @@ subroutine mesh_init(ip,el) 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,19 +414,13 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral - modelName, & - calcMode, & -#endif 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 @@ -514,7 +435,6 @@ subroutine mesh_init(ip,el) 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) @@ -543,63 +463,6 @@ subroutine mesh_init(ip,el) 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) - call mesh_abaqus_count_nodesAndElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_abaqus_count_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_abaqus_count_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted materials'; flush(6) - call mesh_abaqus_map_elementSets(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_abaqus_map_materials(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped materials'; flush(6) - call mesh_abaqus_count_cpElements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_abaqus_map_elements(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_abaqus_map_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_abaqus_build_nodes(FILEUNIT) - if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_abaqus_count_cpSizes(FILEUNIT) - 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) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -614,25 +477,10 @@ subroutine mesh_init(ip,el) 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)))) & @@ -642,11 +490,6 @@ subroutine mesh_init(ip,el) 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. @@ -661,58 +504,6 @@ subroutine mesh_init(ip,el) 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' -!-------------------------------------------------------------------------------------------------- -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 -#endif - !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. !> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). @@ -953,7 +744,6 @@ 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 @@ -1492,1306 +1282,6 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) 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 !-------------------------------------------------------------------------------------------------- @@ -2807,50 +1297,11 @@ use IO, only: & 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 - !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' @@ -2925,444 +1376,6 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral -!-------------------------------------------------------------------------------------------------- -!> @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,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType - 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,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType - 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,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) - mesh_ipNeighborhood = 0_pInt - - - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems - myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem - - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP - neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) - - !*** 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 = FE_geomtype(mesh_element(2,matchingElem)) - - !*** trivial solution if neighbor has only one IP - - if (FE_Nips(neighboringType) == 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,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face - anchor = FE_nodesAtIP(a,myIP,myType) - 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,FE_Nips(neighboringType) - NmatchingNodes = 0_pInt - matchingNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip - anchor = FE_nodesAtIP(a,candidateIP,neighboringType) - 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,mesh_NcpElems ! loop over cpElems - myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! 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 = FE_geomtype(mesh_element(2,neighboringElem)) - do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! 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 - -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 From 55845d222df2796ba6e6b1482dd9f5ae343257db Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:13:40 +0100 Subject: [PATCH 05/92] function was removed --- src/mesh_marc.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index b993b43d6..aa7d77b77 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -380,7 +380,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_tell_statistics, & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & From badf9e9cca1994221ce2e7e1551384c8c1e9c090 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 10:24:10 +0100 Subject: [PATCH 06/92] object oriented element definitions --- src/CMakeLists.txt | 16 +- src/commercialFEM_fileList.f90 | 1 + src/element.f90 | 908 +++++++++++++++++++++++++++++++++ 3 files changed, 919 insertions(+), 6 deletions(-) create mode 100644 src/element.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3818130da..a09ae4766 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -17,6 +17,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 $) @@ -53,21 +57,21 @@ add_library(FEsolving OBJECT "FEsolving.f90") add_dependencies(FEsolving RESULTS) 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 FEsolving) +list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh_grid.f90") - add_dependencies(MESH DAMASK_MATH) + add_dependencies(MESH MATH ELEMENT) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") - add_dependencies(FEZoo DAMASK_MATH) + add_dependencies(FEZoo MATH) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "mesh_FEM.f90") - add_dependencies(MESH FEZoo) + add_dependencies(MESH FEZoo ELEMENT) list(APPEND OBJECTFILES $) endif() diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index a7a61c2f7..7a32e7ade 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -12,6 +12,7 @@ #endif #include "math.f90" #include "FEsolving.f90" +#include "element.f90" #ifdef Abaqus #include "mesh_abaqus.f90" #endif diff --git a/src/element.f90 b/src/element.f90 new file mode 100644 index 000000000..146f24d51 --- /dev/null +++ b/src/element.f90 @@ -0,0 +1,908 @@ +!-------------------------------------------------------------------------------------------------- +!> @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 + end subroutine tElement_init + + + +end module element From 8f106ca8c4fa9308db76b9320b591c129a96d57d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 14:53:23 +0100 Subject: [PATCH 07/92] base class for mesh no functions defined yet, only common variables --- src/CMakeLists.txt | 8 ++++++-- src/mesh_base.f90 | 48 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 2 deletions(-) create mode 100644 src/mesh_base.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index a09ae4766..3292e9cf6 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -61,17 +61,21 @@ add_library(MATH OBJECT "math.f90") add_dependencies(MATH FEsolving) list(APPEND OBJECTFILES $) +add_library(MESH_BASE OBJECT "mesh_base.f90") +add_dependencies(MESH_BASE MATH) +list(APPEND OBJECTFILES $) + # SPECTRAL solver and FEM solver use different mesh files if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_library(MESH OBJECT "mesh_grid.f90") - add_dependencies(MESH MATH ELEMENT) + add_dependencies(MESH MATH) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEZoo OBJECT "FEM_zoo.f90") add_dependencies(FEZoo MATH) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "mesh_FEM.f90") - add_dependencies(MESH FEZoo ELEMENT) + add_dependencies(MESH FEZoo) list(APPEND OBJECTFILES $) endif() diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 new file mode 100644 index 000000000..477fc3aed --- /dev/null +++ b/src/mesh_base.f90 @@ -0,0 +1,48 @@ +!-------------------------------------------------------------------------------------------------- +!> @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) :: solver = "undefined" + 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 + end type tMesh + +end module mesh_base From 7e039dff678381262076a9d1331c8dee4568cc10 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 15:18:53 +0100 Subject: [PATCH 08/92] verbose initialization --- src/element.f90 | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/src/element.f90 b/src/element.f90 index 146f24d51..bd602b3b2 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -900,7 +900,27 @@ contains self%cellFace = CELLFACE3 case(4_pInt) self%cellFace = CELLFACE4 - end select + end select + + + write(6,*) 'tElement_init' + + write(6,*)'elemType ',self%elemType + write(6,*)'geomType ',self%geomType + write(6,*)'cellType ',self%cellType + write(6,*)'Nnodes ',self%Nnodes + write(6,*)'Ncellnodes ',self%Ncellnodes + write(6,*)'NcellnodesPerCell ',self%NcellnodesPerCell + write(6,*)'nIPs ',self%nIPs + write(6,*)'nIPneighbors ',self%nIPneighbors + write(6,*)'maxNnodeAtIP ',self%maxNnodeAtIP + write(6,*)'Cell ',self%Cell + write(6,*)'NnodeAtIP ',self%NnodeAtIP + write(6,*)'IPneighbor ',self%IPneighbor + write(6,*)'cellFace ',self%cellFace + write(6,*)'cellNodeParentNodeWeights',self%cellNodeParentNodeWeights + + end subroutine tElement_init From 738114bc279d0f340c16244adc37835da7f211b8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 15:19:17 +0100 Subject: [PATCH 09/92] clean and initialize element --- src/mesh_grid.f90 | 89 ++++++++++++----------------------------------- 1 file changed, 22 insertions(+), 67 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 7cf7a1e64..fee06bee9 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -8,6 +8,7 @@ module mesh use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -368,7 +369,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & mesh_spectral_getHomogenization, & @@ -378,9 +378,23 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood - + type, public, extends(tMesh) :: tMesh_grid + contains + procedure :: init => tMesh_grid_init + end type tMesh_grid + + type(tMesh_grid), public :: theMesh + contains +subroutine tMesh_grid_init(self) + + implicit none + class(tMesh_grid) :: self + + call self%elem%init(10_pInt) + +end subroutine tMesh_grid_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -502,6 +516,9 @@ subroutine mesh_init(ip,el) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! + + call theMesh%init + end subroutine mesh_init !-------------------------------------------------------------------------------------------------- @@ -985,7 +1002,7 @@ subroutine mesh_spectral_count_cpSizes implicit none integer(pInt) :: t,g,c - t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element + t = 10_pInt g = FE_geomtype(t) c = FE_celltype(g) @@ -1112,7 +1129,7 @@ subroutine mesh_spectral_build_elements(fileUnit) enddo enddo - elemType = FE_mapElemtype('C3D8R') + elemType = 10_pInt 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!) @@ -1377,68 +1394,6 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -!-------------------------------------------------------------------------------------------------- -!> @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 - - !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- @@ -2282,7 +2237,7 @@ integer(pInt) function mesh_get_nodeAtIP(elemtypeFE,ip) mesh_get_nodeAtIP = 0_pInt - elemtype = FE_mapElemtype(elemtypeFE) + elemtype = 10_pInt geomtype = FE_geomtype(elemtype) if (FE_Nips(geomtype) >= ip .and. FE_Nips(geomtype) <= FE_Nnodes(elemtype)) & mesh_get_nodeAtIP = FE_nodesAtIP(1,ip,geomtype) From cda85b0d2de897c08a8fe2e886409c7ea1aa3840 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 15:51:03 +0100 Subject: [PATCH 10/92] might be needed somewhere --- src/element.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/element.f90 b/src/element.f90 index bd602b3b2..4c0f1e810 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -902,6 +902,7 @@ contains self%cellFace = CELLFACE4 end select + self%nIPneighbors = size(self%IPneighbor,1) write(6,*) 'tElement_init' From 7d3ae1673f039fbd6c3843b32df1d3952c8d6685 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 16:16:41 +0100 Subject: [PATCH 11/92] not needed --- src/FEM_utilities.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 index 1db950e63..bf5e62851 100644 --- a/src/FEM_utilities.f90 +++ b/src/FEM_utilities.f90 @@ -503,7 +503,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 From 5c2020c3b483704545f4fe0380faef1b32668841 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 16:17:20 +0100 Subject: [PATCH 12/92] initialize element --- src/mesh_grid.f90 | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index fee06bee9..8b1659ed8 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -379,11 +379,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_spectral_build_ipNeighborhood 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 :: init => tMesh_grid_init end type tMesh_grid - type(tMesh_grid), public :: theMesh + type(tMesh_grid), public, protected :: theMesh contains @@ -444,6 +457,7 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + call theMesh%init 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 @@ -517,7 +531,6 @@ subroutine mesh_init(ip,el) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init end subroutine mesh_init @@ -2194,7 +2207,7 @@ subroutine mesh_build_FEdata 5,6,7,8, & 1,4,3,2 & ],pInt),[FE_NcellnodesPerCellface(me),FE_NipNeighbors(me)]) - + end subroutine mesh_build_FEdata From 42cc9b8d2b59f5718ed5790885de2f14d8df52cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 25 Jan 2019 00:15:46 +0100 Subject: [PATCH 13/92] dependency was missing --- src/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 3292e9cf6..62f44dacb 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -62,7 +62,7 @@ add_dependencies(MATH FEsolving) list(APPEND OBJECTFILES $) add_library(MESH_BASE OBJECT "mesh_base.f90") -add_dependencies(MESH_BASE MATH) +add_dependencies(MESH_BASE MATH ELEMENT) list(APPEND OBJECTFILES $) # SPECTRAL solver and FEM solver use different mesh files From ab93a86b3e0e47c17a98bdca5a355a0382fce5fd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 24 Jan 2019 16:50:23 +0100 Subject: [PATCH 14/92] initialize element where defined --- src/FEM_zoo.f90 | 4 ++-- src/mesh_FEM.f90 | 34 ++++++++++++++++++++++++++++++++-- 2 files changed, 34 insertions(+), 4 deletions(-) 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/mesh_FEM.f90 b/src/mesh_FEM.f90 index 1362063f8..7a784a27f 100644 --- a/src/mesh_FEM.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 @@ -79,6 +79,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 :: init => tMesh_FEM_init + end type tMesh_FEM + + type(tMesh_FEM), public, protected :: theMesh + + public :: & @@ -89,6 +100,23 @@ use PETScis contains +subroutine tMesh_FEM_init(self,dimen,order) + + implicit none + integer(pInt), intent(in) :: dimen,order + class(tMesh_FEM) :: self + + if (dimen == 2_pInt) then + if (order == 1_pInt) call self%elem%init(1_pInt) + if (order == 2_pInt) call self%elem%init(2_pInt) + elseif(dimen == 3_pInt) then + if (order == 1_pInt) call self%elem%init(6_pInt) + if (order == 2_pInt) call self%elem%init(8_pInt) + 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) @@ -243,7 +273,7 @@ subroutine mesh_init() mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%init(dimplex,integrationOrder) end subroutine mesh_init From 3ebc0c2e37b4959cee1b11e3be26905ad3542714 Mon Sep 17 00:00:00 2001 From: navyanthkusam Date: Mon, 28 Jan 2019 13:53:44 +0100 Subject: [PATCH 15/92] tMesh_marc object extends tMesh Functionality seperated for mesh_marc --- src/mesh_marc.f90 | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index aa7d77b77..85b4f3e7d 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -8,6 +8,7 @@ module mesh use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -401,6 +402,46 @@ integer(pInt), dimension(:,:), allocatable, private :: & contains +type, public, extends(tMesh) :: tMesh_marc + + integer(pInt), public :: & + nElemsAll, & + maxNelemInSet, & + NelemSets,& + MarcVersion, & !< Version of input file format ToDo: Better Name? + hypoelasticTableStyle, & !< Table style + initialcondTableStyle + character(len=64), dimension(:), allocatable :: & + nameElemSet,& !< names of elementSet + mesh_nameElemSet, & !< names of elementSet + mapMaterial !< name of elementSet for material + integer(pInt), dimension(:), allocatable :: & + Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) + integer(pInt), dimension(:,:), allocatable, target:: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode + 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 + mesh_NelemSets, & + mesh_maxNelemInSet + integer(pInt), dimension(:,:), allocatable :: & + mesh_mapElemSet !< list of elements in elementSet + integer(pInt), dimension(2):: & + mesh_maxValStateVar = 0_pInt + + contains + procedure :: init => tMesh_marc_init +end type tMesh_marc + + type(tMesh_marc), public, protected :: theMesh +contains + +subroutine tMesh_marc_init(self) + implicit none + class(tMesh_marc) :: self + +end subroutine tMesh_marc_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -478,6 +519,8 @@ subroutine mesh_init(ip,el) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) + + call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -2767,3 +2810,7 @@ end function mesh_get_nodeAtIP end module mesh + + + + From 5101a3796fe5d0aa3a4a4bfd124ca16591f084b1 Mon Sep 17 00:00:00 2001 From: navyanthkusam Date: Mon, 28 Jan 2019 13:59:54 +0100 Subject: [PATCH 16/92] tMesh_abaqus object extends tMesh Functionality seperated for mesh_abaqus --- src/mesh_abaqus.f90 | 1275 ++----------------------------------------- 1 file changed, 38 insertions(+), 1237 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index e55165d51..bc14cd418 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -8,6 +8,7 @@ module mesh use, intrinsic :: iso_c_binding use prec, only: pReal, pInt + use mesh_base implicit none private @@ -62,11 +63,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 +328,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 +342,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 +355,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, & @@ -391,12 +366,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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, & @@ -406,32 +376,9 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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,10 +390,40 @@ 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 + integer(pInt), dimension(:,:), allocatable, target :: & + mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] + mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] + logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information + + contains + procedure :: init=>tMesh_abaqus_init + end type tMesh_Abaqus + + type(tMesh_Abaqus), public, protected :: theMesh + contains +subroutine tMesh_abaqus_init + implicit none + class(tMesh_abaqus) :: self + +end subroutine tMesh_abaqus_init !-------------------------------------------------------------------------------------------------- !> @brief initializes the mesh by calling all necessary private routines the mesh module @@ -457,22 +434,11 @@ subroutine mesh_init(ip,el) 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,19 +453,10 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & -#ifndef Spectral - modelName, & - calcMode, & -#endif 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 @@ -514,65 +471,6 @@ subroutine mesh_init(ip,el) 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) @@ -598,8 +496,6 @@ 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) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -613,40 +509,29 @@ subroutine mesh_init(ip,el) 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. @@ -662,7 +547,6 @@ subroutine mesh_init(ip,el) 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' @@ -711,7 +595,7 @@ integer(pInt) function mesh_FEasCP(what,myID) enddo binarySearch end function mesh_FEasCP -#endif + !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -953,456 +837,6 @@ 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) @@ -1492,622 +926,8 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) 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' @@ -2791,7 +1611,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) enddo 630 end subroutine mesh_abaqus_build_elements -#endif + !-------------------------------------------------------------------------------------------------- @@ -2807,25 +1627,14 @@ use IO, only: & 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 @@ -2849,7 +1658,7 @@ use IO, only: & 610 FORMAT(A300) 620 end subroutine mesh_get_damaskOptions -#endif + !-------------------------------------------------------------------------------------------------- @@ -2925,7 +1734,7 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -#ifndef Spectral + !-------------------------------------------------------------------------------------------------- !> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' !-------------------------------------------------------------------------------------------------- @@ -3227,7 +2036,7 @@ subroutine mesh_build_ipNeighborhood enddo end subroutine mesh_build_ipNeighborhood -#endif + !-------------------------------------------------------------------------------------------------- @@ -3336,14 +2145,6 @@ subroutine mesh_tell_statistics 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 From 09dc1041a55124a0acc8607432d91a73be6f323c Mon Sep 17 00:00:00 2001 From: navyanthkusam Date: Mon, 28 Jan 2019 14:36:44 +0100 Subject: [PATCH 17/92] variable attributes adjusted compiles now --- src/commercialFEM_fileList.f90 | 1 + src/mesh_abaqus.f90 | 8 +++----- src/mesh_marc.f90 | 11 ++++------- 3 files changed, 8 insertions(+), 12 deletions(-) diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 7a32e7ade..d2765929f 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -13,6 +13,7 @@ #include "math.f90" #include "FEsolving.f90" #include "element.f90" +#include "mesh_base.f90" #ifdef Abaqus #include "mesh_abaqus.f90" #endif diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index bc14cd418..5d225bfb9 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -406,9 +406,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_mapMaterial !< name of elementSet for material integer(pInt), dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(:,:), allocatable, target :: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information contains @@ -419,7 +416,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & contains -subroutine tMesh_abaqus_init +subroutine tMesh_abaqus_init(self) implicit none class(tMesh_abaqus) :: self @@ -453,7 +450,8 @@ subroutine mesh_init(ip,el) numerics_unitlength, & worldrank use FEsolving, only: & - FEsolving_execElem, & + modelName, & + calcMode, & FEsolving_execElem, & FEsolving_execIP implicit none diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 85b4f3e7d..3e0447285 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -3,7 +3,7 @@ !> @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 +!> @brief Sets up the mesh for the solver MSC.Marc !-------------------------------------------------------------------------------------------------- module mesh use, intrinsic :: iso_c_binding @@ -400,8 +400,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_count_cpSizes, & mesh_marc_build_elements -contains - type, public, extends(tMesh) :: tMesh_marc integer(pInt), public :: & @@ -417,10 +415,7 @@ type, public, extends(tMesh) :: tMesh_marc mapMaterial !< name of elementSet for material integer(pInt), dimension(:), allocatable :: & Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) - integer(pInt), dimension(:,:), allocatable, target:: & - mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] - mesh_mapFEtoCPnode - integer(pInt), private :: & + 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, & @@ -435,6 +430,8 @@ type, public, extends(tMesh) :: tMesh_marc end type tMesh_marc type(tMesh_marc), public, protected :: theMesh + + contains subroutine tMesh_marc_init(self) From 346561beed2e7f8332158f1a277fce17612c0289 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 28 Jan 2019 18:46:47 +0100 Subject: [PATCH 18/92] fixed dependencies --- src/CMakeLists.txt | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 62f44dacb..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 $) @@ -38,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") @@ -46,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") @@ -54,28 +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(MATH OBJECT "math.f90") -add_dependencies(MATH FEsolving) +add_dependencies(MATH NUMERICS) list(APPEND OBJECTFILES $) add_library(MESH_BASE OBJECT "mesh_base.f90") -add_dependencies(MESH_BASE MATH ELEMENT) +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_grid.f90") - add_dependencies(MESH MATH) + 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 MATH) + add_dependencies(FEZoo IO) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "mesh_FEM.f90") - add_dependencies(MESH FEZoo) + add_dependencies(MESH FEZoo MESH_BASE MATH FEsolving) list(APPEND OBJECTFILES $) endif() @@ -83,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 @@ -96,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 @@ -113,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") From beb0ca01eb388721ee78caa62df777a0e534318c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 11:29:56 +0100 Subject: [PATCH 19/92] define functions where needed only use solver specific element names --- src/IO.f90 | 143 ++++++++++++++++---------------------------- src/mesh_abaqus.f90 | 68 +++++++++++---------- src/mesh_marc.f90 | 36 +++-------- 3 files changed, 97 insertions(+), 150 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 1f9ff937c..66ebb2d88 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -57,19 +57,11 @@ module IO public :: & IO_open_inputFile, & IO_open_logFile -#endif -#ifdef Abaqus - public :: & - IO_abaqus_hasNoPart #endif private :: & IO_fixedFloatValue, & IO_verifyFloatValue, & IO_verifyIntValue -#ifdef Abaqus - private :: & - abaqus_assembleInputFile -#endif contains @@ -385,6 +377,59 @@ 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) + + 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 #endif #ifdef Marc4DAMASK path = trim(modelName)//inputFileExtension @@ -556,35 +601,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 !-------------------------------------------------------------------------------------------------- @@ -1598,57 +1614,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/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 5d225bfb9..1758c5986 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -434,7 +434,6 @@ subroutine mesh_init(ip,el) #endif use DAMASK_interface use IO, only: & - IO_abaqus_hasNoPart, & IO_open_InputFile, & IO_timeStamp, & IO_error, & @@ -471,7 +470,7 @@ subroutine mesh_init(ip,el) 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) @@ -542,6 +541,33 @@ subroutine mesh_init(ip,el) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! +contains +!-------------------------------------------------------------------------------------------------- +!> @brief check if the input file for Abaqus contains part info +!-------------------------------------------------------------------------------------------------- +logical function hasNoPart(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line + + 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 + hasNoPart = .false. + exit + endif + enddo + +620 end function hasNoPart + end subroutine mesh_init @@ -1497,7 +1523,6 @@ subroutine mesh_abaqus_build_elements(fileUnit) use IO, only: IO_lc, & IO_stringValue, & - IO_skipChunks, & IO_stringPos, & IO_intValue, & IO_extractValue, & @@ -2173,49 +2198,28 @@ integer(pInt) function FE_mapElemtype(what) 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', & + case ( 'cpe4', & 'cpe4t') FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27', & - 'cpe8', & + case ( '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', & + case ( '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', & + case ( 'c3d6', & 'c3d6t') FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral - case ( '117', & - '123', & - 'c3d8r', & + case ( 'c3d8r', & 'c3d8rt') FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7', & - 'c3d8', & + case ( 'c3d8', & 'c3d8t') FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57', & - 'c3d20r', & + case ( 'c3d20r', & 'c3d20rt') FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21', & - 'c3d20', & + case ( 'c3d20', & 'c3d20t') FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral case default diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 3e0447285..67c343ebe 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -1909,44 +1909,28 @@ integer(pInt) function FE_mapElemtype(what) '125', & '128') FE_mapElemtype = 2_pInt ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric) - case ( '11', & - 'cpe4', & - 'cpe4t') + case ( '11') FE_mapElemtype = 3_pInt ! Arbitrary Quadrilateral Plane-strain - case ( '27', & - 'cpe8', & - 'cpe8t') + 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', & - 'c3d4', & - 'c3d4t') + 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', & - 'c3d6', & - 'c3d6t') + case ( '136') FE_mapElemtype = 9_pInt ! Three-dimensional Arbitrarily Distorted Pentahedral case ( '117', & - '123', & - 'c3d8r', & - 'c3d8rt') + '123') FE_mapElemtype = 10_pInt ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration - case ( '7', & - 'c3d8', & - 'c3d8t') + case ( '7') FE_mapElemtype = 11_pInt ! Three-dimensional Arbitrarily Distorted Brick - case ( '57', & - 'c3d20r', & - 'c3d20rt') + case ( '57') FE_mapElemtype = 12_pInt ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration - case ( '21', & - 'c3d20', & - 'c3d20t') + 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)) @@ -2807,7 +2791,3 @@ end function mesh_get_nodeAtIP end module mesh - - - - From 615b1669928c6f66b2bbc8d83b95242be4947a46 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 11:39:28 +0100 Subject: [PATCH 20/92] removed unused stuff --- src/CPFEM2.f90 | 2 -- src/IO.f90 | 31 ------------------------------- src/constitutive.f90 | 1 - src/mesh_marc.f90 | 4 ---- 4 files changed, 38 deletions(-) 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/IO.f90 b/src/IO.f90 index 66ebb2d88..698b8f1d5 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -30,7 +30,6 @@ module IO IO_open_jobFile, & IO_write_jobFile, & IO_write_jobRealFile, & - IO_write_jobIntFile, & IO_read_realFile, & IO_read_intFile, & IO_isBlank, & @@ -515,36 +514,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 diff --git a/src/constitutive.f90 b/src/constitutive.f90 index a0d7147a6..43d57a493 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -56,7 +56,6 @@ subroutine constitutive_init() IO_checkAndRewind, & IO_open_jobFile_stat, & IO_write_jobFile, & - IO_write_jobIntFile, & IO_timeStamp use config, only: & config_phase diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 67c343ebe..3db48fe8c 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -515,9 +515,6 @@ subroutine mesh_init(ip,el) 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) - - - call mesh_get_damaskOptions(FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity @@ -532,7 +529,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built IP areas'; flush(6) close (FILEUNIT) - call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems From bcd9908a88b1e138354935ebac1c47bb7a18276f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 12:23:23 +0100 Subject: [PATCH 21/92] all variables/functions were not used --- src/homogenization.f90 | 2 - src/mesh_abaqus.f90 | 50 -------- src/mesh_grid.f90 | 267 ++--------------------------------------- src/mesh_marc.f90 | 62 +--------- 4 files changed, 12 insertions(+), 369 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index ac41158a1..20ce008fd 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -74,7 +74,6 @@ subroutine homogenization_init mesh_maxNips, & mesh_NcpElems, & mesh_element, & - FE_Nips, & FE_geomtype use constitutive, only: & constitutive_plasticity_maxSizePostResults, & @@ -346,7 +345,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) crystallite_Lp, & crystallite_Li0, & crystallite_Li, & - crystallite_dPdF, & crystallite_Tstar0_v, & crystallite_Tstar_v, & crystallite_partionedF0, & diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 1758c5986..ec6b11ffa 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -363,9 +363,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_ipVolumes, & mesh_build_ipCoordinates, & mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & mesh_FEasCP private :: & @@ -3033,51 +3030,4 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() - - implicit none - - mesh_get_Ncellnodes = mesh_Ncellnodes - -end function mesh_get_Ncellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @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 - - end module mesh diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 8b1659ed8..a2a041955 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -61,10 +61,7 @@ module mesh 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(2), private :: & - mesh_maxValStateVar = 0_pInt + 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 @@ -81,9 +78,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & real(pReal), dimension(:,:,:), allocatable, private :: & FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes - integer(pInt), dimension(:,:,:,:), allocatable, private :: & - FE_subNodeOnIPFace - ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" @@ -192,86 +186,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type int([ & 3, & ! element 6 (2D 3node 1ip) @@ -354,29 +268,24 @@ integer(pInt), dimension(:,:), allocatable, private :: & public :: & mesh_init, & - mesh_build_cellnodes, & - mesh_build_ipVolumes, & - mesh_build_ipCoordinates, & - mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & + mesh_cellCenterCoordinates - mesh_spectral_getGrid, & - mesh_spectral_getSize private :: & - mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_faceMatch, & mesh_build_FEdata, & mesh_spectral_getHomogenization, & mesh_spectral_count, & mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & - mesh_spectral_build_ipNeighborhood + mesh_spectral_build_ipNeighborhood, & + mesh_spectral_getGrid, & + mesh_spectral_getSize, & + mesh_build_cellnodes, & + mesh_build_ipVolumes, & + mesh_build_ipCoordinates type, public, extends(tMesh) :: tMesh_grid @@ -437,9 +346,7 @@ subroutine mesh_init(ip,el) debug_mesh, & debug_levelBasic use numerics, only: & - usePingPong, & - numerics_unitlength, & - worldrank + numerics_unitlength use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -491,8 +398,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) call mesh_spectral_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(FILEUNIT) - if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -1160,8 +1065,6 @@ subroutine mesh_spectral_build_elements(fileUnit) 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) @@ -1314,25 +1217,6 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) end function mesh_nodesAroundCentres -!-------------------------------------------------------------------------------------------------- -!> @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 - - - mesh_periodicSurface = .true. - - end subroutine mesh_get_damaskOptions - - !-------------------------------------------------------------------------------------------------- !> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal' !-------------------------------------------------------------------------------------------------- @@ -1407,93 +1291,6 @@ subroutine mesh_build_ipAreas end subroutine mesh_build_ipAreas -!-------------------------------------------------------------------------------------------------- -!> @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,FE_geomtype(mesh_element(2,elem)))) :: & - 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 = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType - -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 = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate -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 - - !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements !> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace @@ -2212,50 +2009,4 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() - - implicit none - - mesh_get_Ncellnodes = mesh_Ncellnodes - -end function mesh_get_Ncellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @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 = 10_pInt - 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 - - end module mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 3db48fe8c..7deb14fff 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -67,9 +67,6 @@ module mesh mesh_maxNelemInSet, & mesh_Nmaterials - integer(pInt), dimension(2), private :: & - mesh_maxValStateVar = 0_pInt - integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID @@ -371,9 +368,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_ipVolumes, & mesh_build_ipCoordinates, & mesh_cellCenterCoordinates, & - mesh_get_Ncellnodes, & - mesh_get_unitlength, & - mesh_get_nodeAtIP, & mesh_FEasCP @@ -422,9 +416,7 @@ type, public, extends(tMesh) :: tMesh_marc mesh_maxNelemInSet integer(pInt), dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet - integer(pInt), dimension(2):: & - mesh_maxValStateVar = 0_pInt - + contains procedure :: init => tMesh_marc_init end type tMesh_marc @@ -1442,7 +1434,6 @@ subroutine mesh_marc_build_elements(fileUnit) 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 @@ -1493,12 +1484,12 @@ use IO, only: & 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 + 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? + 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' @@ -2739,51 +2730,4 @@ subroutine mesh_build_FEdata end subroutine mesh_build_FEdata - -!-------------------------------------------------------------------------------------------------- -!> @brief returns global variable mesh_Ncellnodes -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_get_Ncellnodes() - - implicit none - - mesh_get_Ncellnodes = mesh_Ncellnodes - -end function mesh_get_Ncellnodes - - -!-------------------------------------------------------------------------------------------------- -!> @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 - - end module mesh From b9c834f86a60b8789404d187c9586786ca998eba Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 31 Jan 2019 17:01:26 +0100 Subject: [PATCH 22/92] missing use from IO --- src/mesh_abaqus.f90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index ec6b11ffa..8c93a899a 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -543,7 +543,11 @@ 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 From b87a09a46698faf233c1dbbea4c896fd929a5f36 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 11:22:06 +0100 Subject: [PATCH 23/92] not needed --- src/mesh_abaqus.f90 | 5 +---- src/mesh_marc.f90 | 5 +---- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 8c93a899a..98bdda4ef 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -746,10 +746,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 diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 7deb14fff..2cca47239 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -730,10 +730,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 From 5f8b110f63cd69dcaea26d239ab35e2d51bc4107 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 12:24:23 +0100 Subject: [PATCH 24/92] initialize mesh and element --- src/mesh_abaqus.f90 | 109 +++++--------------------------------------- src/mesh_base.f90 | 20 +++++++- src/mesh_grid.f90 | 86 +++++++++++----------------------- src/mesh_marc.f90 | 17 +++++-- 4 files changed, 70 insertions(+), 162 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 98bdda4ef..62ece4c93 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -389,7 +389,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_abaqus_build_elements - type, public, extends(tMesh) :: tMesh_Abaqus + type, public, extends(tMesh) :: tMesh_abaqus integer(pInt):: & mesh_Nelems, & !< total number of elements in mesh (including non-DAMASK elements) @@ -406,16 +406,22 @@ integer(pInt), dimension(:,:), allocatable, private :: & logical:: noPart !< for cases where the ABAQUS input file does not use part/assembly information contains - procedure :: init=>tMesh_abaqus_init - end type tMesh_Abaqus + procedure, pass(self) :: tMesh_abaqus_init + generic, public :: init => tMesh_abaqus_init + end type tMesh_abaqus - type(tMesh_Abaqus), public, protected :: theMesh + type(tMesh_abaqus), public, protected :: theMesh contains -subroutine tMesh_abaqus_init(self) +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 @@ -537,7 +543,7 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%init(mesh_element(2,1),mesh_node0) contains !-------------------------------------------------------------------------------------------------- !> @brief check if the input file for Abaqus contains part info @@ -859,97 +865,6 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates - -!-------------------------------------------------------------------------------------------------- -!> @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 - - !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of nodes and elements in mesh and stores them in !! 'mesh_Nelems' and 'mesh_Nnodes' diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index 477fc3aed..f9a076f03 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -29,7 +29,7 @@ module mesh_base 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) :: solver = "undefined" + character(pStringLen) :: type = "n/a" integer(pInt) :: & Nnodes, & !< total number of nodes in mesh Nelems = -1_pInt, & @@ -43,6 +43,24 @@ module mesh_base microstructureAt integer(pInt), dimension(:,:), allocatable, public :: & connectivity + contains + procedure, pass(self) :: tMesh_base_init + 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 + + self%type = meshType + call self%elem%init(elemType) + self%node0 = nodes + +end subroutine tMesh_base_init + end module mesh_base diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index a2a041955..cff0dbc21 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -270,14 +270,11 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_init, & mesh_cellCenterCoordinates - private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & mesh_build_FEdata, & mesh_spectral_getHomogenization, & - mesh_spectral_count, & - mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & @@ -302,19 +299,21 @@ integer(pInt), dimension(:,:), allocatable, private :: & size3offset contains - procedure :: init => tMesh_grid_init + 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) +subroutine tMesh_grid_init(self,nodes) implicit none class(tMesh_grid) :: self + real(pReal), dimension(:,:), intent(in) :: nodes - call self%elem%init(10_pInt) + call self%tMesh%init('grid',10_pInt,nodes) end subroutine tMesh_grid_init @@ -364,7 +363,8 @@ subroutine mesh_init(ip,el) write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - call theMesh%init + + 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 @@ -389,13 +389,23 @@ subroutine mesh_init(ip,el) 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) + mesh_NcpElems= product(grid(1:2))*grid3 + 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) + ! For compatibility + + mesh_maxNips = theMesh%elem%nIPs + mesh_maxNipNeighbors = theMesh%elem%nIPneighbors + mesh_maxNcellnodes = theMesh%elem%Ncellnodes + + + call mesh_spectral_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_build_cellconnectivity @@ -434,8 +444,6 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - - end subroutine mesh_init @@ -563,10 +571,9 @@ 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 @@ -894,43 +901,6 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) 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 = 10_pInt - 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' @@ -941,7 +911,6 @@ subroutine mesh_spectral_build_nodes() 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 * & @@ -986,7 +955,6 @@ subroutine mesh_spectral_build_elements(fileUnit) headerLength = 0_pInt, & maxDataPerLine, & homog, & - elemType, & elemOffset integer(pInt), dimension(:), allocatable :: & microstructures, & @@ -1047,13 +1015,13 @@ subroutine mesh_spectral_build_elements(fileUnit) enddo enddo - elemType = 10_pInt + 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( 2,e) = 10_pInt mesh_element( 3,e) = homog ! homogenization mesh_element( 4,e) = microGlobal(e+elemOffset) ! microstructure mesh_element( 5,e) = e + (e-1_pInt)/grid(1) + & diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 2cca47239..5607791fb 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -417,8 +417,9 @@ type, public, extends(tMesh) :: tMesh_marc integer(pInt), dimension(:,:), allocatable :: & mesh_mapElemSet !< list of elements in elementSet - contains - procedure :: init => tMesh_marc_init + contains + procedure, pass(self) :: tMesh_marc_init + generic, public :: init => tMesh_marc_init end type tMesh_marc type(tMesh_marc), public, protected :: theMesh @@ -426,10 +427,15 @@ end type tMesh_marc contains -subroutine tMesh_marc_init(self) +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 !-------------------------------------------------------------------------------------------------- @@ -553,7 +559,8 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%init(mesh_element(2,1),mesh_node0) + end subroutine mesh_init From 614a8d694cbbd2442dcc83f14f97270e2f8e82cd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 12:28:18 +0100 Subject: [PATCH 25/92] re-implement mesh reporting later on in mesh_base --- src/mesh_abaqus.f90 | 132 -------------------------------------------- 1 file changed, 132 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 62ece4c93..159f2a7f6 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -369,7 +369,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_get_damaskOptions, & mesh_build_cellconnectivity, & mesh_build_ipAreas, & - mesh_tell_statistics, & FE_mapElemtype, & mesh_faceMatch, & mesh_build_FEdata, & @@ -516,10 +515,6 @@ subroutine mesh_init(ip,el) call mesh_build_ipNeighborhood if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (worldrank == 0_pInt) then - call mesh_tell_statistics - endif - if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements if (debug_e < 1 .or. debug_e > mesh_NcpElems) & @@ -1974,133 +1969,6 @@ subroutine mesh_build_ipNeighborhood end subroutine mesh_build_ipNeighborhood - -!-------------------------------------------------------------------------------------------------- -!> @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 - 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 !-------------------------------------------------------------------------------------------------- From 8e0556fe3e8cdd0fdb685b88c017e65ec32592c0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 12:43:14 +0100 Subject: [PATCH 26/92] [skip ci] nicer reporting --- src/element.f90 | 28 ++++++++++------------------ src/mesh_base.f90 | 7 ++++++- 2 files changed, 16 insertions(+), 19 deletions(-) diff --git a/src/element.f90 b/src/element.f90 index 4c0f1e810..473d9c73c 100644 --- a/src/element.f90 +++ b/src/element.f90 @@ -904,26 +904,18 @@ contains self%nIPneighbors = size(self%IPneighbor,1) - write(6,*) 'tElement_init' - - write(6,*)'elemType ',self%elemType - write(6,*)'geomType ',self%geomType - write(6,*)'cellType ',self%cellType - write(6,*)'Nnodes ',self%Nnodes - write(6,*)'Ncellnodes ',self%Ncellnodes - write(6,*)'NcellnodesPerCell ',self%NcellnodesPerCell - write(6,*)'nIPs ',self%nIPs - write(6,*)'nIPneighbors ',self%nIPneighbors - write(6,*)'maxNnodeAtIP ',self%maxNnodeAtIP - write(6,*)'Cell ',self%Cell - write(6,*)'NnodeAtIP ',self%NnodeAtIP - write(6,*)'IPneighbor ',self%IPneighbor - write(6,*)'cellFace ',self%cellFace - write(6,*)'cellNodeParentNodeWeights',self%cellNodeParentNodeWeights + 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/mesh_base.f90 b/src/mesh_base.f90 index f9a076f03..e0ca78c03 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -57,10 +57,15 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes) 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 - + end subroutine tMesh_base_init end module mesh_base From 3d750e793339a4a6e601f44b7f5b04b6344057ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 1 Feb 2019 21:56:38 +0100 Subject: [PATCH 27/92] overwriting of init did not work --- src/mesh_FEM.f90 | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index 7a784a27f..b9d171fc3 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -84,14 +84,13 @@ use PETScis contains - procedure :: init => tMesh_FEM_init + 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, & mesh_FEM_build_ipVolumes, & @@ -100,22 +99,24 @@ use PETScis contains -subroutine tMesh_FEM_init(self,dimen,order) +subroutine tMesh_FEM_init(self,dimen,order,nodes) implicit none - integer(pInt), intent(in) :: dimen,order + 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%elem%init(1_pInt) - if (order == 2_pInt) call self%elem%init(2_pInt) + 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%elem%init(6_pInt) - if (order == 2_pInt) call self%elem%init(8_pInt) + 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 + end subroutine tMesh_FEM_init + !-------------------------------------------------------------------------------------------------- @@ -273,7 +274,9 @@ subroutine mesh_init() mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init(dimplex,integrationOrder) + allocate(mesh_node0(3,mesh_Nnodes),source=0.0_pReal) + call theMesh%init(dimplex,integrationOrder,mesh_node0) + end subroutine mesh_init From 4a2828405862ef7567b6dec90f2fd25d5a7b28cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 09:18:01 +0100 Subject: [PATCH 28/92] only parse geom file once --- src/mesh_grid.f90 | 386 ++++++++++++++++++++-------------------------- 1 file changed, 163 insertions(+), 223 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index cff0dbc21..942611b1f 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -28,6 +28,8 @@ module mesh mesh_maxNcellnodes !< max number of cell nodes in any CP element !!!! BEGIN DEPRECATED !!!!! + 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 @@ -278,8 +280,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & - mesh_spectral_getGrid, & - mesh_spectral_getSize, & mesh_build_cellnodes, & mesh_build_ipVolumes, & mesh_build_ipCoordinates @@ -354,7 +354,6 @@ subroutine mesh_init(ip,el) include 'fftw3-mpi.f03' integer(C_INTPTR_T) :: devNull, local_K, local_K_offset integer :: ierr, worldsize - integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt), intent(in), optional :: el, ip integer(pInt) :: j logical :: myDebug @@ -363,7 +362,6 @@ subroutine mesh_init(ip,el) 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 @@ -371,14 +369,14 @@ subroutine mesh_init(ip,el) myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) 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 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)') - 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, & @@ -395,19 +393,20 @@ subroutine mesh_init(ip,el) 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%init(mesh_node) + ! For compatibility - mesh_maxNips = theMesh%elem%nIPs mesh_maxNipNeighbors = theMesh%elem%nIPneighbors mesh_maxNcellnodes = theMesh%elem%Ncellnodes - - call mesh_spectral_build_elements(FILEUNIT) + call mesh_spectral_build_elements() + if (myDebug) write(6,'(a)') ' Built elements'; flush(6) + call mesh_build_cellconnectivity if (myDebug) write(6,'(a)') ' Built cell connectivity'; flush(6) mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) @@ -418,7 +417,6 @@ 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) call mesh_spectral_build_ipNeighborhood @@ -683,17 +681,14 @@ pure function mesh_cellCenterCoordinates(ip,el) enddo mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(FE_NcellnodesPerCell(c),pReal) - end function mesh_cellCenterCoordinates +end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!> @brief Parses geometry file !-------------------------------------------------------------------------------------------------- -function mesh_spectral_getGrid(fileUnit) +subroutine mesh_spectral_read_grid() use IO, only: & - IO_checkAndRewind, & - IO_open_file, & IO_stringPos, & IO_lc, & IO_stringValue, & @@ -703,145 +698,158 @@ function mesh_spectral_getGrid(fileUnit) 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 + implicit none + character(len=:), allocatable :: rawData + character(len=65536) :: line + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt), dimension(3) :: g = -1_pInt + real(pReal), dimension(3) :: s = -1_pInt + integer(pInt) :: h =- 1_pInt + integer(pInt) :: & + headerLength = -1_pInt, & + fileLength, & + fileUnit, & + startPos, endPos, & + myStat, & + l, i, j, e, c + logical :: & + gotGrid = .false., & + gotSize = .false., & + gotHomogenization = .false. - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, j, myFileUnit - logical :: gotGrid = .false. +!-------------------------------------------------------------------------------------------------- +! 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 + 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 - mesh_spectral_getGrid = -1_pInt - if(.not. present(fileUnit)) then - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - else - myFileUnit = fileUnit - endif +!-------------------------------------------------------------------------------------------------- +! read and interprete header + l = 0 + do while (l < headerLength .and. startPos < len(rawData)) + endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + line = rawData(startPos:endPos) + startPos = endPos + 1_pInt + l = l + 1_pInt - call IO_checkAndRewind(myFileUnit) + ! cycle empty lines + chunkPos = IO_stringPos(trim(line)) + select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) ) + + case ('grid') + if (chunkPos(1) > 6) gotGrid = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('a') + g(1) = IO_intValue(line,chunkPos,j+1_pInt) + case('b') + g(2) = IO_intValue(line,chunkPos,j+1_pInt) + case('c') + g(3) = IO_intValue(line,chunkPos,j+1_pInt) + end select + enddo + + case ('size') + if (chunkPos(1) > 6) gotSize = .true. + do j = 2_pInt,6_pInt,2_pInt + select case (IO_lc(IO_stringValue(line,chunkPos,j))) + case('x') + s(1) = IO_floatValue(line,chunkPos,j+1_pInt) + case('y') + s(2) = IO_floatValue(line,chunkPos,j+1_pInt) + case('z') + s(3) = IO_floatValue(line,chunkPos,j+1_pInt) + end select + enddo + + case ('homogenization') + if (chunkPos(1) > 1) gotHomogenization = .true. + h = IO_intValue(line,chunkPos,2_pInt) - 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 + end select - if(.not. present(fileUnit)) close(myFileUnit) + enddo - 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') +!-------------------------------------------------------------------------------------------------- +! global data + grid = g + geomSize = s + allocate(microGlobal(product(grid)), source = -1_pInt) + +!-------------------------------------------------------------------------------------------------- +! read and interprete content + e = 1_pInt + do while (startPos < len(rawData)) + endPos = startPos + index(rawData(startPos:),new_line('')) - 1_pInt + line = rawData(startPos:endPos) + startPos = endPos + 1_pInt + l = l + 1_pInt -end function mesh_spectral_getGrid + chunkPos = IO_stringPos(trim(line)) + if (chunkPos(1) == 3) then + 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 + c = IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1) + 1_pInt + microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3))] + else + c = chunkPos(1) + do i = 0_pInt, c - 1_pInt + microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) + enddo + endif + else + c = chunkPos(1) + do i = 0_pInt, c - 1_pInt + microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) + enddo + + endif + + e = e+c + end do + + if (e-1 /= product(grid)) print*, 'mist', e + +! 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') + +! 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') + +! 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 subroutine mesh_spectral_read_grid !-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, -!! assumes an opened file, otherwise tries to open the one specified in geometryFile +!> @brief Reads homogenization information from geometry file. !-------------------------------------------------------------------------------------------------- -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) +integer(pInt) function mesh_spectral_getHomogenization() use IO, only: & IO_checkAndRewind, & IO_open_file, & @@ -854,7 +862,6 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) geometryFile implicit none - integer(pInt), intent(in), optional :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: headerLength = 0_pInt character(len=1024) :: line, & @@ -862,13 +869,10 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) 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) @@ -891,7 +895,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) end select enddo - if(.not. present(fileUnit)) close(myFileUnit) + close(myFileUnit) if (.not. gotHomogenization ) & call IO_error(error_ID = 845_pInt, ext_msg='homogenization') @@ -935,85 +939,21 @@ end subroutine mesh_spectral_build_nodes !! Allocates global array 'mesh_element' !> @todo does the IO_error makes sense? !-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_build_elements(fileUnit) +subroutine mesh_spectral_build_elements() use IO, only: & - IO_checkAndRewind, & - IO_lc, & - IO_stringValue, & - IO_stringPos, & - IO_error, & - IO_continuousIntValues, & - IO_intValue, & - IO_countContinuousIntValues - + IO_error implicit none - integer(pInt), intent(in) :: & - fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & e, i, & - headerLength = 0_pInt, & - maxDataPerLine, & + homog, & 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 + homog = mesh_spectral_getHomogenization() -!-------------------------------------------------------------------------------------------------- -! 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 elemOffset = product(grid(1:2))*grid3Offset From 5810dce618685deeb027645e8caf265628b2f781 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 09:29:58 +0100 Subject: [PATCH 29/92] better avoid jump marks --- src/mesh_abaqus.f90 | 54 ++++++++++++++++----------------------------- 1 file changed, 19 insertions(+), 35 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 159f2a7f6..bf5c77642 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -540,6 +540,8 @@ subroutine mesh_init(ip,el) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) contains + + !-------------------------------------------------------------------------------------------------- !> @brief check if the input file for Abaqus contains part info !-------------------------------------------------------------------------------------------------- @@ -557,10 +559,9 @@ logical function hasNoPart(fileUnit) hasNoPart = .true. -610 FORMAT(A65536) rewind(fileUnit) do - read(fileUnit,610,END=620) line + read(fileUnit,'(a65536)',END=620) line chunkPos = IO_stringPos(line) if (IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) then hasNoPart = .false. @@ -882,12 +883,11 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt -610 FORMAT(A300) inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',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. & @@ -942,12 +942,10 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) 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 + read (fileUnit,'(a300)',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. & @@ -984,12 +982,10 @@ subroutine mesh_abaqus_count_materials(fileUnit) mesh_Nmaterials = 0_pInt -610 FORMAT(A300) - inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',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. & @@ -1031,12 +1027,10 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) 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 + read (fileUnit,'(a300)',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. & @@ -1083,11 +1077,10 @@ subroutine mesh_abaqus_map_materials(fileUnit) 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 + read (fileUnit,'(a300)',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. & @@ -1145,11 +1138,10 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) mesh_NcpElems = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',END=620) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1200,11 +1192,10 @@ subroutine mesh_abaqus_map_elements(fileUnit) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=660) line + read (fileUnit,'(a300)',END=660) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) case('*material') @@ -1263,11 +1254,9 @@ subroutine mesh_abaqus_map_nodes(fileUnit) allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source=0_pInt) -610 FORMAT(A300) - rewind(fileUnit) do - read (fileUnit,610,END=650) line + read (fileUnit,'(a300)',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. & @@ -1326,12 +1315,10 @@ subroutine mesh_abaqus_build_nodes(fileUnit) 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 + read (fileUnit,'(a300)',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. & @@ -1349,7 +1336,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) backspace(fileUnit) ! rewind to first entry enddo do i = 1_pInt,c - read (fileUnit,610,END=670) line + read (fileUnit,'(a300)',END=670) line chunkPos = IO_stringPos(line) m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) do j=1_pInt, 3_pInt @@ -1393,12 +1380,11 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt -610 FORMAT(A300) inPart = .false. rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(a300)',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. & @@ -1451,12 +1437,10 @@ subroutine mesh_abaqus_build_elements(fileUnit) 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 + read (fileUnit,'(a300)',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. & @@ -1474,8 +1458,8 @@ subroutine mesh_abaqus_build_elements(fileUnit) backspace(fileUnit) enddo do i = 1_pInt,c - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) ! limit to 64 nodes max + read (fileUnit,'(a300)',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 @@ -1507,7 +1491,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) materialFound = .false. do - read (fileUnit,610,END=630) line + read (fileUnit,'(a300)',END=630) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) case('*material') @@ -1516,7 +1500,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) 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 + read (fileUnit,'(a300)',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) From 9975048f2946eb7f474683b121689ac7cee92fa0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 09:56:11 +0100 Subject: [PATCH 30/92] better avoid jump marks: Abaqus, Part 2 --- src/mesh_abaqus.f90 | 168 +++++++++++++++++++++++++------------------- 1 file changed, 96 insertions(+), 72 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index bf5c77642..5c761ad7e 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -878,16 +878,17 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line + integer :: myStat logical :: inPart mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt - - + inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -915,7 +916,7 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) endif enddo -620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) + 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 @@ -937,15 +938,17 @@ subroutine mesh_abaqus_count_elementSets(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 - read (fileUnit,'(a300)',END=620) line + 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. & @@ -955,7 +958,6 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) 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 @@ -978,14 +980,16 @@ subroutine mesh_abaqus_count_materials(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - logical inPart + integer :: myStat + logical :: inPart mesh_Nmaterials = 0_pInt inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -997,7 +1001,7 @@ subroutine mesh_abaqus_count_materials(fileUnit) mesh_Nmaterials = mesh_Nmaterials + 1_pInt enddo -620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) + if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) end subroutine mesh_abaqus_count_materials @@ -1021,16 +1025,20 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: elemSet = 0_pInt,i - logical :: inPart = .false. + 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 - read (fileUnit,'(a300)',END=640) line + 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. & @@ -1044,7 +1052,7 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) endif enddo -640 do i = 1_pInt,elemSet + 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 @@ -1068,19 +1076,21 @@ subroutine mesh_abaqus_map_materials(fileUnit) 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=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 - read (fileUnit,'(a300)',END=620) line + 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. & @@ -1108,7 +1118,7 @@ subroutine mesh_abaqus_map_materials(fileUnit) endif enddo -620 if (c==0_pInt) call IO_error(error_ID=905_pInt) + 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 @@ -1131,17 +1141,18 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line + character(len=300) :: line + integer :: myStat + logical :: materialFound integer(pInt) :: i,k - logical :: materialFound = .false. character(len=64) ::materialName,elemSetName mesh_NcpElems = 0_pInt - - + materialFound = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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') @@ -1163,7 +1174,7 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) endselect enddo -620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) + if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) end subroutine mesh_abaqus_count_cpElements @@ -1186,16 +1197,19 @@ subroutine mesh_abaqus_map_elements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) ::i,j,k,cpElem = 0_pInt - logical :: materialFound = .false. + 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 - read (fileUnit,'(a300)',END=660) line + 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') @@ -1222,7 +1236,7 @@ subroutine mesh_abaqus_map_elements(fileUnit) endselect enddo -660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + 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) @@ -1247,16 +1261,19 @@ subroutine mesh_abaqus_map_nodes(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - integer(pInt) :: i,c,cpNode = 0_pInt - logical :: inPart = .false. + 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 - read (fileUnit,'(a300)',END=650) line + 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. & @@ -1283,7 +1300,7 @@ subroutine mesh_abaqus_map_nodes(fileUnit) endif enddo -650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) + 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) @@ -1309,16 +1326,18 @@ subroutine mesh_abaqus_build_nodes(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,j,m,c + 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 - read (fileUnit,'(a300)',END=670) line + 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. & @@ -1346,7 +1365,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) endif enddo -670 if (int(size(mesh_node0,2_pInt),pInt) /= mesh_Nnodes) call IO_error(error_ID=909_pInt) + 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 @@ -1372,8 +1391,9 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line - integer(pInt) :: i,c,t,g + integer :: myStat logical :: inPart + integer(pInt) :: i,c,t,g mesh_maxNnodes = 0_pInt mesh_maxNips = 0_pInt @@ -1382,9 +1402,10 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -1406,7 +1427,7 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) endif enddo -620 end subroutine mesh_abaqus_count_cpSizes +end subroutine mesh_abaqus_count_cpSizes !-------------------------------------------------------------------------------------------------- @@ -1428,19 +1449,21 @@ subroutine mesh_abaqus_build_elements(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - + character(len=300) :: line + integer :: myStat + logical :: inPart 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 inPart = .false. + myStat = 0 rewind(fileUnit) - do - read (fileUnit,'(a300)',END=620) line + 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. & @@ -1487,11 +1510,13 @@ subroutine mesh_abaqus_build_elements(fileUnit) enddo -620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" + rewind(fileUnit) ! just in case "*material" definitions apear before "*element" materialFound = .false. - do - read (fileUnit,'(a300)',END=630) line + 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') @@ -1525,7 +1550,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) endselect enddo -630 end subroutine mesh_abaqus_build_elements +end subroutine mesh_abaqus_build_elements @@ -1543,17 +1568,18 @@ use IO, only: & integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) :: line + integer :: myStat + logical :: inPart integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword + character(len=300) :: damaskOption, v + character(len=*), parameter :: keyword = '**damask' mesh_periodicSurface = .false. - keyword = '**damask' - - + myStat = 0 rewind(fileUnit) - do - read (fileUnit,610,END=620) line + 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)) == keyword .and. Nchunks > 1_pInt) then ! found keyword for damask option and there is at least one more chunk to read @@ -1570,9 +1596,7 @@ use IO, only: & endif enddo -610 FORMAT(A300) - -620 end subroutine mesh_get_damaskOptions +end subroutine mesh_get_damaskOptions From e17278a926de759ba65207fa007d913a7164599b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:11:18 +0100 Subject: [PATCH 31/92] using new mesh structure (initial test) --- src/constitutive.f90 | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 43d57a493..ac8ee0484 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -59,8 +59,6 @@ subroutine constitutive_init() IO_timeStamp use config, only: & config_phase - use mesh, only: & - FE_geomtype use config, only: & material_Nphase, & material_localFileExt, & @@ -789,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, & @@ -841,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) :: & @@ -1003,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, & @@ -1060,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) From f0b5b9fd593d672a9ab2cb97fcdb4bd71a7408e9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:34:16 +0100 Subject: [PATCH 32/92] unused variable --- src/homogenization.f90 | 3 +-- src/material.f90 | 6 ++---- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 20ce008fd..1c02d1088 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -73,8 +73,7 @@ subroutine homogenization_init use mesh, only: & mesh_maxNips, & mesh_NcpElems, & - mesh_element, & - FE_geomtype + mesh_element use constitutive, only: & constitutive_plasticity_maxSizePostResults, & constitutive_source_maxSizePostResults diff --git a/src/material.f90 b/src/material.f90 index 3ae6c16a4..dbf5433c6 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -306,8 +306,7 @@ subroutine material_init() use mesh, only: & mesh_homogenizationAt, & mesh_NipsPerElem, & - mesh_NcpElems, & - FE_geomtype + mesh_NcpElems implicit none integer(pInt), parameter :: FILEUNIT = 210_pInt @@ -989,8 +988,7 @@ subroutine material_populateGrains mesh_homogenizationAt, & mesh_microstructureAt, & mesh_NcpElems, & - mesh_ipVolume, & - FE_geomtype + mesh_ipVolume use config, only: & config_homogenization, & config_microstructure, & From 7a8d98d135ccd685198433bbb1d611dfe20cbb8a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:35:10 +0100 Subject: [PATCH 33/92] using theMesh (object oriented mesh description) --- src/crystallite.f90 | 62 +++++++++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 30 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index 45aca46d1..db00d3ac2 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 @@ -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,7 @@ 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) :: & formerSubStep integer(pInt) :: & @@ -541,7 +535,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 +721,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 +922,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 +953,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 +1060,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 @@ -2128,7 +2118,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 +2159,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 +2192,8 @@ end subroutine update_stress !> @brief tbd !-------------------------------------------------------------------------------------------------- subroutine update_dependentState() + use mesh, only: & + mesh_element use constitutive, only: & constitutive_dependentState => constitutive_microstructure @@ -2232,6 +2226,8 @@ subroutine update_state(timeFraction) sourceState, & phase_Nsources, & phaseAt, phasememberAt + use mesh, only: & + mesh_element implicit none real(pReal), intent(in) :: & @@ -2281,6 +2277,8 @@ subroutine update_dotState(timeFraction) sourceState, & phaseAt, phasememberAt, & phase_Nsources + use mesh, only: & + mesh_element use constitutive, only: & constitutive_collectDotState @@ -2334,6 +2332,8 @@ subroutine update_deltaState IEEE_arithmetic use prec, only: & dNeq0 + use mesh, only: & + mesh_element use material, only: & plasticState, & sourceState, & @@ -2429,6 +2429,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: & From 3a5a50cb03c7bd20a0caa5403c7d881d2d29e6e8 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 10:53:55 +0100 Subject: [PATCH 34/92] use variables from theMesh --- src/crystallite.f90 | 3 ++- src/homogenization.f90 | 36 ++++++++++++++++++------------------ 2 files changed, 20 insertions(+), 19 deletions(-) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index db00d3ac2..1eb2dff28 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -426,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 @@ -469,6 +469,7 @@ function crystallite_stress() implicit none 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) :: & diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 1c02d1088..8edecbc88 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -71,8 +71,7 @@ subroutine homogenization_init debug_e, & debug_g use mesh, only: & - mesh_maxNips, & - mesh_NcpElems, & + theMesh, & mesh_element use constitutive, only: & constitutive_plasticity_maxSizePostResults, & @@ -242,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 @@ -275,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() @@ -597,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 @@ -611,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 From 94a24e45eeaca801c7c1e7dd0404d165865a646c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 11:46:38 +0100 Subject: [PATCH 35/92] bugfixes: theMesh%Nelems need to be set (using an intermediate function until a routine does that) spectral.geom file can have "N+n to N" (backwards counting) --- src/mesh_FEM.f90 | 1 + src/mesh_abaqus.f90 | 1 + src/mesh_base.f90 | 12 ++++++++++++ src/mesh_grid.f90 | 20 +++++++++++++------- src/mesh_marc.f90 | 2 +- 5 files changed, 28 insertions(+), 8 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index b9d171fc3..e2b08db4c 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -276,6 +276,7 @@ subroutine mesh_init() !!!!!!!!!!!!!!!!!!!!!!!! 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_abaqus.f90 b/src/mesh_abaqus.f90 index 5c761ad7e..05e1d7c7d 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -421,6 +421,7 @@ subroutine tMesh_abaqus_init(self,elemType,nodes) integer(pInt), intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) + call theMesh%setNelems(mesh_NcpElems) end subroutine tMesh_abaqus_init diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index e0ca78c03..c0f012256 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -45,6 +45,7 @@ module mesh_base 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 @@ -68,4 +69,15 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes) 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 index 942611b1f..88484a693 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -442,7 +442,7 @@ subroutine mesh_init(ip,el) mesh_microstructureAt = mesh_element(4,:) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! - + call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init !-------------------------------------------------------------------------------------------------- @@ -686,6 +686,8 @@ end function mesh_cellCenterCoordinates !-------------------------------------------------------------------------------------------------- !> @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: & @@ -706,12 +708,16 @@ subroutine mesh_spectral_read_grid() real(pReal), dimension(3) :: s = -1_pInt integer(pInt) :: h =- 1_pInt integer(pInt) :: & - headerLength = -1_pInt, & - fileLength, & + headerLength = -1_pInt, & !< length of header (in lines) + fileLength, & !< lenght of the geom file (in characters) fileUnit, & startPos, endPos, & myStat, & - l, i, j, e, c + l, & !< line counter + c, & !< counter for # microstructures in line + o, & !< order of "to" packing + e, & !< "element", i.e. spectral collocation point + i, j logical :: & gotGrid = .false., & gotSize = .false., & @@ -807,8 +813,9 @@ subroutine mesh_spectral_read_grid() 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 - c = IO_intValue(line,chunkPos,3) - IO_intValue(line,chunkPos,1) + 1_pInt - microGlobal(e:e+c-1_pInt) = [(i, i = IO_intValue(line,chunkPos,1),IO_intValue(line,chunkPos,3))] + 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 c = chunkPos(1) do i = 0_pInt, c - 1_pInt @@ -822,7 +829,6 @@ subroutine mesh_spectral_read_grid() enddo endif - e = e+c end do diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 5607791fb..dd4098879 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -560,7 +560,7 @@ subroutine mesh_init(ip,el) mesh_CPnodeID = mesh_element(5:4+mesh_NipsPerElem,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) - + call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init From 8962635136b26af41bca45ba290df5c1ffb4f5cc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 11:50:07 +0100 Subject: [PATCH 36/92] use new elem/mesh variables --- src/plastic_nonlocal.f90 | 96 ++++++++++++++++------------------------ 1 file changed, 39 insertions(+), 57 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index e1355da8f..32cde9768 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -281,8 +281,7 @@ use IO, only: IO_read, & use debug, only: debug_level, & debug_constitutive, & debug_levelBasic -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & +use mesh, only: theMesh, & mesh_maxNipNeighbors use material, only: phase_plasticity, & homogenization_maxNgrains, & @@ -1091,23 +1090,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,mesh_maxNipNeighbors,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) @@ -1404,10 +1403,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, & @@ -1446,8 +1443,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) @@ -1462,8 +1459,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) @@ -1476,8 +1473,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 @@ -1559,16 +1556,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, & @@ -1628,7 +1622,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 @@ -1639,7 +1633,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) :: & @@ -1714,7 +1708,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) @@ -2400,16 +2394,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, & @@ -2435,9 +2425,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 @@ -2716,8 +2706,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) @@ -3016,11 +3006,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 @@ -3030,7 +3016,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 @@ -3049,7 +3035,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, & @@ -3061,7 +3047,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) @@ -3174,15 +3160,12 @@ use math, only: math_mul33x33, & math_inv33, & math_transpose33, & pi -use mesh, only: mesh_NcpElems, & - mesh_maxNips, & +use mesh, only: theMesh, & mesh_element, & mesh_node0, & mesh_cellCenterCoordinates, & mesh_ipVolume, & - mesh_periodicSurface, & - FE_Nips, & - FE_geomtype + mesh_periodicSurface use material, only: homogenization_maxNgrains, & material_phase, & plasticState, & @@ -3197,7 +3180,7 @@ implicit none !*** input variables integer(pInt), intent(in) :: ip, & !< current integration point el !< current element -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 !*** output variables @@ -3295,8 +3278,8 @@ if (.not. phase_localPlasticity(ph)) then !* loop through all material points (also through their periodic images if present), !* but only consider nonlocal neighbors within a certain cutoff radius R - do neighbor_el = 1_pInt,mesh_NcpElems - ipLoop: do neighbor_ip = 1_pInt,FE_Nips(FE_geomtype(mesh_element(2,neighbor_el))) + do neighbor_el = 1_pInt,theMesh%nElems + ipLoop: do neighbor_ip = 1_pInt,theMesh%elem%nIPs neighbor_phase = material_phase(1_pInt,neighbor_ip,neighbor_el) np = phaseAt(1,neighbor_ip,neighbor_el) no = phasememberAt(1,neighbor_ip,neighbor_el) @@ -3523,8 +3506,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, & @@ -3542,7 +3524,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 From dcd16dda70b2e5ff94610fbafb1417bd95cdb115 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 12:15:05 +0100 Subject: [PATCH 37/92] variables from mesh object --- src/CPFEM.f90 | 15 +++++------- src/crystallite.f90 | 16 ++++++------- src/material.f90 | 56 ++++++++++++++++++++------------------------- 3 files changed, 38 insertions(+), 49 deletions(-) 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/crystallite.f90 b/src/crystallite.f90 index 1eb2dff28..c272abd07 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -1745,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, & @@ -1771,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 !-------------------------------------------------------------------------------------------------- @@ -1922,8 +1921,7 @@ end subroutine integrateStateRK4 subroutine integrateStateRKCK45() use mesh, only: & mesh_element, & - mesh_NcpElems, & - mesh_maxNips + theMesh use material, only: & homogenization_Ngrains, & plasticState, & @@ -1970,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 diff --git a/src/material.f90 b/src/material.f90 index dbf5433c6..4160c906e 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -305,8 +305,7 @@ subroutine material_init() texture_name use mesh, only: & mesh_homogenizationAt, & - mesh_NipsPerElem, & - mesh_NcpElems + theMesh implicit none integer(pInt), parameter :: FILEUNIT = 210_pInt @@ -398,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) @@ -409,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) @@ -552,7 +551,7 @@ subroutine material_parseMicrostructure microstructure_name use mesh, only: & mesh_microstructureAt, & - mesh_NcpElems + theMesh implicit none character(len=65536), dimension(:), allocatable :: & @@ -570,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) @@ -983,11 +982,9 @@ subroutine material_populateGrains math_sampleFiberOri, & math_symmetricEulers use mesh, only: & - mesh_NipsPerElem, & - mesh_elemType, & mesh_homogenizationAt, & mesh_microstructureAt, & - mesh_NcpElems, & + theMesh, & mesh_ipVolume use config, only: & config_homogenization, & @@ -1024,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 @@ -1059,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 @@ -1070,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 @@ -1104,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 @@ -1259,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 @@ -1301,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) From 4f2a3d7f5505469e379c310fcd242d90afca890f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 12:23:53 +0100 Subject: [PATCH 38/92] unused variables --- src/mesh_FEM.f90 | 2 -- src/mesh_abaqus.f90 | 4 ---- src/mesh_grid.f90 | 9 +-------- src/mesh_marc.f90 | 4 ---- 4 files changed, 1 insertion(+), 18 deletions(-) diff --git a/src/mesh_FEM.f90 b/src/mesh_FEM.f90 index e2b08db4c..ed80cbcba 100644 --- a/src/mesh_FEM.f90 +++ b/src/mesh_FEM.f90 @@ -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 :: & @@ -269,7 +268,6 @@ 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,:) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 05e1d7c7d..74401e5e5 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -18,7 +18,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 @@ -33,7 +32,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) @@ -532,12 +530,10 @@ subroutine mesh_init(ip,el) !!!! 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,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) contains diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 88484a693..3d3680935 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -14,11 +14,9 @@ module mesh private integer(pInt), public, protected :: & mesh_NcpElems, & !< total number of CP elements in local mesh - 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_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 @@ -35,10 +33,7 @@ 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) + 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] @@ -435,12 +430,10 @@ subroutine mesh_init(ip,el) !!!! 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,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%setNelems(mesh_NcpElems) end subroutine mesh_init diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index dd4098879..c20bf84d7 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -18,7 +18,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 @@ -33,7 +32,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) @@ -552,12 +550,10 @@ subroutine mesh_init(ip,el) !!!! 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,:) !!!!!!!!!!!!!!!!!!!!!!!! call theMesh%init(mesh_element(2,1),mesh_node0) call theMesh%setNelems(mesh_NcpElems) From b514bf78a5f225aa0b5216978d67407678bc4aac Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 12:31:07 +0100 Subject: [PATCH 39/92] avoiding duplicated variables --- src/mesh_grid.f90 | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 3d3680935..875993290 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -22,7 +22,6 @@ module mesh mesh_maxNsharedElems !< max number of CP elements sharing a node !!!! BEGIN DEPRECATED !!!!! integer(pInt), public, protected :: & - mesh_maxNips, & !< max number of IPs in any CP element mesh_maxNcellnodes !< max number of cell nodes in any CP element !!!! BEGIN DEPRECATED !!!!! @@ -393,10 +392,9 @@ subroutine mesh_init(ip,el) call theMesh%init(mesh_node) ! For compatibility - mesh_maxNips = theMesh%elem%nIPs mesh_maxNipNeighbors = theMesh%elem%nIPneighbors mesh_maxNcellnodes = theMesh%elem%Ncellnodes - +call theMesh%setNelems(mesh_NcpElems) call mesh_spectral_build_elements() @@ -435,7 +433,7 @@ subroutine mesh_init(ip,el) mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%setNelems(mesh_NcpElems) + end subroutine mesh_init !-------------------------------------------------------------------------------------------------- @@ -459,7 +457,7 @@ subroutine mesh_build_cellconnectivity matchingNodeID, & localCellnodeID - allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) + allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,mesh_NcpElems), source=0_pInt) allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) @@ -563,7 +561,7 @@ subroutine mesh_build_ipVolumes real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + allocate(mesh_ipVolume(theMesh%elem%nIPs,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) @@ -634,7 +632,7 @@ subroutine mesh_build_ipCoordinates real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + allocate(mesh_ipCoordinates(3,theMesh%elem%nIPs,mesh_NcpElems),source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) do e = 1_pInt,mesh_NcpElems ! loop over cpElems @@ -989,7 +987,7 @@ subroutine mesh_spectral_build_ipNeighborhood integer(pInt) :: & x,y,z, & e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems),source=0_pInt) e = 0_pInt do z = 0_pInt,grid3-1_pInt @@ -1136,8 +1134,8 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) do e = 1_pInt,mesh_NcpElems ! loop over cpElems From 933136ec1e3486765f6373476e50ede8010380b5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 13:10:21 +0100 Subject: [PATCH 40/92] nNodes form element is used already --- src/mesh_base.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/mesh_base.f90 b/src/mesh_base.f90 index c0f012256..5afdbc3ad 100644 --- a/src/mesh_base.f90 +++ b/src/mesh_base.f90 @@ -1,3 +1,4 @@ + !-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH @@ -66,6 +67,7 @@ subroutine tMesh_base_init(self,meshType,elemType,nodes) self%type = meshType call self%elem%init(elemType) self%node0 = nodes + self%nNodes = size(nodes,2) end subroutine tMesh_base_init From 3edbfc1cb5759474bac68feca7de299f374b5de3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 15:10:35 +0100 Subject: [PATCH 41/92] bugfix: infinite loop for geom file without new line at end also, a lot of cleaning --- src/IO.f90 | 12 +- src/mesh_grid.f90 | 1483 ++++++++++----------------------------------- 2 files changed, 339 insertions(+), 1156 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 5c86ee966..bef14ea1e 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -1329,11 +1329,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) @@ -1355,13 +1353,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) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index 875993290..d3741b766 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -13,17 +13,12 @@ module mesh implicit none private integer(pInt), public, protected :: & - mesh_NcpElems, & !< total number of CP elements in local 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_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 !!!!! - integer(pInt), public, protected :: & - mesh_maxNcellnodes !< max number of cell nodes in any CP element -!!!! BEGIN DEPRECATED !!!!! + integer(pInt), dimension(:), allocatable, private :: & microGlobal @@ -66,135 +61,22 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell integer(pInt), dimension(:,:,:), allocatable, private :: & - FE_nodesAtIP, & !< map IP index to node indices in a specific type of element - FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element - FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell - real(pReal), dimension(:,:,:), allocatable, private :: & - FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes ! 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, & + integer(pInt), parameter, private :: & FE_Ngeomtypes = 10_pInt, & FE_Ncelltypes = 4_pInt, & - FE_maxNnodes = 20_pInt, & - FE_maxNips = 27_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_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 3, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 3, & ! element 54 (2D 8node 4ip) - 5, & ! element 134 (3D 4node 1ip) - 6, & ! element 157 (3D 5node 4ip) - 6, & ! element 127 (3D 10node 4ip) - 7, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 9, & ! element 7 (3D 8node 8ip) - 9, & ! element 57 (3D 20node 8ip) - 10 & ! element 21 (3D 20node 27ip) - ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 4, & ! element 136 (3D 6node 6ip) - 4, & ! element 117 (3D 8node 1ip) - 4, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type - int([ & - 2, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 3, & ! element 127 (3D 10node 4ip) - 3, & ! element 136 (3D 6node 6ip) - 3, & ! element 117 (3D 8node 1ip) - 3, & ! element 7 (3D 8node 8ip) - 3 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element - int([ & - 3, & ! element 6 (2D 3node 1ip) - 6, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 8, & ! element 27 (2D 8node 9ip) - 8, & ! element 54 (2D 8node 4ip) - 4, & ! element 134 (3D 4node 1ip) - 5, & ! element 157 (3D 5node 4ip) - 10, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 20, & ! element 57 (3D 20node 8ip) - 20 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: 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_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type - int([ & - 3, & ! element 6 (2D 3node 1ip) - 7, & ! element 125 (2D 6node 3ip) - 9, & ! element 11 (2D 4node 4ip) - 16, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 15, & ! element 127 (3D 10node 4ip) - 21, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 27, & ! element 7 (3D 8node 8ip) - 64 & ! element 21 (3D 20node 27ip) - ],pInt) integer(pInt), dimension(FE_Ncelltypes), parameter, private :: FE_NcellnodesPerCell = & !< number of cell nodes in a specific cell type int([ & @@ -212,21 +94,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element - int([ & - 1, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 9, & ! element 27 (2D 8node 9ip) - 1, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 1, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 27 & ! element 21 (3D 20node 27ip) - ],pInt) - integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + 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) @@ -235,21 +104,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],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) - 1, & ! element 125 (2D 6node 3ip) - 1, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 1, & ! element 127 (3D 10node 4ip) - 1, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 1, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(3), public, protected :: & grid !< (global) grid integer(pInt), public, protected :: & @@ -356,8 +210,7 @@ subroutine mesh_init(ip,el) 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) @@ -381,7 +234,7 @@ subroutine mesh_init(ip,el) 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_NcpElems= product(grid(1:2))*grid3 + mesh_NcpElemsGlobal = product(grid) mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) @@ -393,13 +246,14 @@ subroutine mesh_init(ip,el) ! For compatibility mesh_maxNipNeighbors = theMesh%elem%nIPneighbors - mesh_maxNcellnodes = theMesh%elem%Ncellnodes -call theMesh%setNelems(mesh_NcpElems) +call theMesh%setNelems(product(grid(1:2))*grid3) 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) @@ -415,265 +269,26 @@ call theMesh%setNelems(mesh_NcpElems) if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + 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 > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & + 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,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 + 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 - mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - + deallocate(mesh_cell) end subroutine mesh_init -!-------------------------------------------------------------------------------------------------- -!> @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(mesh_maxNcellnodes) :: & - localCellnode2globalCellnode - integer(pInt) :: & - e,t,g,c,n,i, & - matchingNodeID, & - localCellnodeID - - allocate(mesh_cell(FE_maxNcellnodesPerCell,theMesh%elem%nIPs,mesh_NcpElems), source=0_pInt) - allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) - -!-------------------------------------------------------------------------------------------------- -! Count cell nodes (including duplicates) and generate cell connectivity list - mesh_Ncellnodes = 0_pInt - mesh_Ncells = 0_pInt - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - localCellnode2globalCellnode = 0_pInt - mesh_Ncells = mesh_Ncells + FE_Nips(g) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell - localCellnodeID = FE_cell(n,i,g) - if (localCellnodeID <= FE_NmatchingNodes(g)) 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,t,n,m, & - localCellnodeID - real(pReal), dimension(3) :: & - myCoords - - mesh_build_cellnodes = 0.0_pReal -!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) - do n = 1_pInt,Ncellnodes ! loop over cell nodes - e = mesh_cellnodeParent(1,n) - localCellnodeID = mesh_cellnodeParent(2,n) - t = mesh_element(2,e) ! get element type - myCoords = 0.0_pReal - do m = 1_pInt,FE_Nnodes(t) - myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & - * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) - enddo - mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) - 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,mesh_NcpElems),source=0.0_pReal) - - - !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - select case (c) - - case (1_pInt) ! 2D 3node - forall (i = 1_pInt:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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,FE_Nips(g) ! 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,mesh_NcpElems),source=0.0_pReal) - - !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,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=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) :: t,g,c,n - - t = mesh_element(2_pInt,el) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - 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 Parses geometry file @@ -695,12 +310,10 @@ subroutine mesh_spectral_read_grid() character(len=:), allocatable :: rawData character(len=65536) :: line integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt), dimension(3) :: g = -1_pInt - real(pReal), dimension(3) :: s = -1_pInt integer(pInt) :: h =- 1_pInt integer(pInt) :: & headerLength = -1_pInt, & !< length of header (in lines) - fileLength, & !< lenght of the geom file (in characters) + fileLength, & !< length of the geom file (in characters) fileUnit, & startPos, endPos, & myStat, & @@ -709,10 +322,9 @@ subroutine mesh_spectral_read_grid() o, & !< order of "to" packing e, & !< "element", i.e. spectral collocation point i, j - logical :: & - gotGrid = .false., & - gotSize = .false., & - gotHomogenization = .false. + + grid = -1_pInt + geomSize = -1.0_pReal !-------------------------------------------------------------------------------------------------- ! read data as stream @@ -728,6 +340,7 @@ subroutine mesh_spectral_read_grid() ! 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)) @@ -741,52 +354,58 @@ subroutine mesh_spectral_read_grid() 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 - ! cycle empty lines chunkPos = IO_stringPos(trim(line)) - select case ( IO_lc(IO_StringValue(trim(line),chunkPos,1_pInt,.true.)) ) + 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) gotGrid = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('a') - g(1) = IO_intValue(line,chunkPos,j+1_pInt) - case('b') - g(2) = IO_intValue(line,chunkPos,j+1_pInt) - case('c') - g(3) = IO_intValue(line,chunkPos,j+1_pInt) - end select - enddo + 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) gotSize = .true. - do j = 2_pInt,6_pInt,2_pInt - select case (IO_lc(IO_stringValue(line,chunkPos,j))) - case('x') - s(1) = IO_floatValue(line,chunkPos,j+1_pInt) - case('y') - s(2) = IO_floatValue(line,chunkPos,j+1_pInt) - case('z') - s(3) = IO_floatValue(line,chunkPos,j+1_pInt) - end select - enddo + 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) gotHomogenization = .true. - h = IO_intValue(line,chunkPos,2_pInt) - + if (chunkPos(1) > 1) h = IO_intValue(line,chunkPos,2_pInt) end select enddo !-------------------------------------------------------------------------------------------------- -! global data - grid = g - geomSize = s +! 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) !-------------------------------------------------------------------------------------------------- @@ -794,52 +413,34 @@ subroutine mesh_spectral_read_grid() 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)) - if (chunkPos(1) == 3) then - if (IO_lc(IO_stringValue(line,chunkPos,2)) == 'of') then + + possibleCompression: 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 possibleCompression + 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 + 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 + else compression c = chunkPos(1) - do i = 0_pInt, c - 1_pInt - microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) - enddo - endif - else - c = chunkPos(1) - do i = 0_pInt, c - 1_pInt - microGlobal(e+i) = IO_intValue(line,chunkPos,i+1_pInt) - enddo + microGlobal(e:e+c-1_pInt) = [(IO_intValue(line,chunkPos,i+1_pInt), i=0_pInt, c-1_pInt)] + endif compression + endif possibleCompression - endif e = e+c end do - if (e-1 /= product(grid)) print*, 'mist', e + if (e-1 /= product(grid)) call IO_error(error_ID = 843_pInt, el=e) -! 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') - -! 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') - -! 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 subroutine mesh_spectral_read_grid @@ -866,7 +467,6 @@ integer(pInt) function mesh_spectral_getHomogenization() integer(pInt) :: i, myFileUnit logical :: gotHomogenization = .false. - myFileUnit = 289_pInt call IO_open_file(myFileUnit,trim(geometryFile)) @@ -941,7 +541,7 @@ subroutine mesh_spectral_build_elements() IO_error implicit none integer(pInt) :: & - e, i, & + e, & homog, & elemOffset @@ -950,12 +550,12 @@ subroutine mesh_spectral_build_elements() homog = mesh_spectral_getHomogenization() - allocate(mesh_element (4_pInt+8_pInt,mesh_NcpElems), source = 0_pInt) + allocate(mesh_element (4_pInt+8_pInt,theMesh%nElems), source = 0_pInt) 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!) + do while (e < theMesh%nElems) ! 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) = 10_pInt @@ -972,7 +572,7 @@ subroutine mesh_spectral_build_elements() mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt enddo - if (e /= mesh_NcpElems) call IO_error(880_pInt,e) + if (e /= theMesh%nElems) call IO_error(880_pInt,e) end subroutine mesh_spectral_build_elements @@ -987,7 +587,7 @@ subroutine mesh_spectral_build_ipNeighborhood integer(pInt) :: & x,y,z, & e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems),source=0_pInt) + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems),source=0_pInt) e = 0_pInt do z = 0_pInt,grid3-1_pInt @@ -1122,6 +722,260 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) 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' !-------------------------------------------------------------------------------------------------- @@ -1134,18 +988,16 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,mesh_NcpElems), source=0.0_pReal) + allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) !$OMP PARALLEL DO PRIVATE(t,g,c,nodePos,normal,normals) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + 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,FE_Nips(g) ! loop over ips=cells in this element + 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)) @@ -1158,7 +1010,7 @@ subroutine mesh_build_ipAreas enddo case (3_pInt) ! 3D 4node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + 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)) @@ -1175,7 +1027,7 @@ subroutine mesh_build_ipAreas ! 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,FE_Nips(g) ! loop over ips=cells in this element + 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)) @@ -1198,678 +1050,15 @@ end subroutine mesh_build_ipAreas !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements -!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_subNodeOnIPFace !-------------------------------------------------------------------------------------------------- subroutine mesh_build_FEdata implicit none integer(pInt) :: me - allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) - !*** fill FE_nodesAtIP with data *** - - me = 0_pInt - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - 1,2,3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, & - 2, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, & - 2, & - 4, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1,0, & - 1,2, & - 2,0, & - 1,4, & - 0,0, & - 2,3, & - 4,0, & - 3,4, & - 3,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - 1,2,3,4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 1, & - 2, & - 3, & - 4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 1, & - 2, & - 3, & - 4, & - 5, & - 6 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - 1,2,3,4,5,6,7,8 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 1, & - 2, & - 4, & - 3, & - 5, & - 6, & - 8, & - 7 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - 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),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - - ! *** 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. - me = 0_pInt - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - -2,-3,-1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 2,-3, 3,-1, & - -2, 1, 3,-1, & - 2,-3,-2, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 2,-4, 3,-1, & - -2, 1, 4,-1, & - 4,-4,-3, 1, & - -2, 3,-3, 2 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - -1,-2,-3,-4 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - -3,-5,-4,-2,-6,-1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cell *** - me = 0_pInt - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - 1,2,3 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, 4, 7, 6, & - 2, 5, 7, 4, & - 3, 6, 7, 5 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, 5, 9, 8, & - 5, 2, 6, 9, & - 8, 9, 7, 4, & - 9, 6, 3, 7 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - 1, 2, 3, 4 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - 1, 2, 3, 4, 5, 6, 7, 8 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cellnodeParentnodeWeights *** - ! center of gravity of the weighted nodes gives the position of the cell node. - ! fill with 0. - ! 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 - me = 0_pInt - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) - reshape(real([& - 1, 0, 0, & - 0, 1, 0, & - 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - - ! *** FE_cellface *** me = 0_pInt From 07cca77fcefc109d2d9c96df42d452c9bb1d2600 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 17:19:12 +0100 Subject: [PATCH 42/92] left over jump marks --- src/mesh_abaqus.f90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 74401e5e5..8d6f950a5 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -1288,7 +1288,7 @@ subroutine mesh_abaqus_map_nodes(fileUnit) backspace(fileUnit) enddo do i = 1_pInt,c - read (fileUnit,610,END=650) line + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) cpNode = cpNode + 1_pInt mesh_mapFEtoCPnode(1_pInt,cpNode) = IO_intValue(line,chunkPos,1_pInt) @@ -1352,7 +1352,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) backspace(fileUnit) ! rewind to first entry enddo do i = 1_pInt,c - read (fileUnit,'(a300)',END=670) line + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) do j=1_pInt, 3_pInt @@ -1448,9 +1448,8 @@ subroutine mesh_abaqus_build_elements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - logical :: inPart + logical :: inPart, materialFound integer(pInt) :: i,j,k,c,e,t,homog,micro, nNodesAlreadyRead - logical inPart,materialFound character (len=64) :: materialName,elemSetName allocate(mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) @@ -1478,7 +1477,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) backspace(fileUnit) enddo do i = 1_pInt,c - read (fileUnit,'(a300)',END=620) line + 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 @@ -1493,7 +1492,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) 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 + read (fileUnit,'(a300)') line chunkPos = IO_stringPos(line) do j = 1_pInt,chunkPos(1) mesh_element(4_pInt+nNodesAlreadyRead+j,e) & @@ -1522,7 +1521,7 @@ subroutine mesh_abaqus_build_elements(fileUnit) case('*user') if ( IO_lc(IO_StringValue(line,chunkPos,2_pInt)) == 'material' .and. & materialFound ) then - read (fileUnit,'(a300)',END=630) line ! read homogenization and microstructure + 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) From 819ec40b44bacba084ceec95287a5a718ebb28e0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 15:57:05 +0100 Subject: [PATCH 43/92] clearer order: 1) parse file 2) set up element 3) set up mesh --- src/mesh_abaqus.f90 | 19 +++++++++---------- src/mesh_marc.f90 | 17 +++++++++-------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 8d6f950a5..909ab1e0e 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -18,7 +18,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_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 !!!!! @@ -419,7 +418,6 @@ subroutine tMesh_abaqus_init(self,elemType,nodes) integer(pInt), intent(in) :: elemType call self%tMesh%init('mesh',elemType,nodes) - call theMesh%setNelems(mesh_NcpElems) end subroutine tMesh_abaqus_init @@ -464,7 +462,6 @@ subroutine mesh_init(ip,el) 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) @@ -496,6 +493,12 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_get_damaskOptions(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) @@ -506,7 +509,6 @@ 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) call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) call mesh_build_sharedElems @@ -527,15 +529,12 @@ subroutine mesh_init(ip,el) 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 !!!! -! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. -! hence, xxPerElem instead of maxXX - mesh_NcellnodesPerElem = mesh_maxNcellnodes + ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) -!!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init(mesh_element(2,1),mesh_node0) + + contains diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index c20bf84d7..601939c53 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -18,7 +18,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_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 !!!!! @@ -478,7 +477,7 @@ subroutine mesh_init(ip,el) 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) @@ -513,6 +512,12 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) call mesh_get_damaskOptions(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) @@ -523,7 +528,7 @@ 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) + call mesh_build_nodeTwins if (myDebug) write(6,'(a)') ' Built node twins'; flush(6) @@ -548,15 +553,11 @@ subroutine mesh_init(ip,el) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" !!!! COMPATIBILITY HACK !!!! -! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. -! hence, xxPerElem instead of maxXX - mesh_NcellnodesPerElem = mesh_maxNcellnodes ! better name mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! - call theMesh%init(mesh_element(2,1),mesh_node0) - call theMesh%setNelems(mesh_NcpElems) + end subroutine mesh_init From d51a379376a6b2ed4fd9370b144a9c8766f82a8d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 16:17:52 +0100 Subject: [PATCH 44/92] avoid jump labels --- src/mesh_marc.f90 | 82 ++++++++++++++++++++--------------------------- 1 file changed, 35 insertions(+), 47 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 601939c53..d39f4efdb 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -863,11 +863,10 @@ subroutine mesh_marc_get_fileFormat(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',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) @@ -898,11 +897,10 @@ subroutine mesh_marc_get_tableStyles(fileUnit) initialcondTableStyle = 0_pInt hypoelasticTableStyle = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + 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 @@ -931,13 +929,12 @@ subroutine mesh_marc_get_matNumber(fileUnit) 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 + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then read (fileUnit,610,END=620) line @@ -981,11 +978,10 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & @@ -1021,11 +1017,10 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) mesh_NelemSets = 0_pInt mesh_maxNelemInSet = 0_pInt -610 FORMAT(A300) rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'define' .and. & @@ -1061,11 +1056,10 @@ subroutine mesh_marc_map_elementSets(fileUnit) 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 + 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 @@ -1101,16 +1095,15 @@ subroutine mesh_marc_count_cpElements(fileUnit) mesh_NcpElems = 0_pInt -610 FORMAT(A300) rewind(fileUnit) if (MarcVersion < 13) then ! Marc 2016 or earlier do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',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 + read (fileUnit,'(A300)',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 @@ -1118,10 +1111,10 @@ subroutine mesh_marc_count_cpElements(fileUnit) enddo else ! Marc2017 and later do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',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) @@ -1158,12 +1151,11 @@ subroutine mesh_marc_map_elements(fileUnit) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) -610 FORMAT(A300) contInts = 0_pInt rewind(fileUnit) do - read (fileUnit,610,END=660) line + 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 @@ -1176,11 +1168,11 @@ subroutine mesh_marc_map_elements(fileUnit) endif else ! Marc2017 and later if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then - read (fileUnit,610,END=660) line + read (fileUnit,'(A300)',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 + 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 @@ -1228,18 +1220,17 @@ subroutine mesh_marc_map_nodes(fileUnit) 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 + read (fileUnit,'(A300)',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 + read (fileUnit,'(A300)',END=650) line ! skip crap line do i = 1_pInt,mesh_Nnodes - read (fileUnit,610,END=650) line + read (fileUnit,'(A300)',END=650) line mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) mesh_mapFEtoCPnode(2_pInt,i) = i enddo @@ -1276,16 +1267,15 @@ subroutine mesh_marc_build_nodes(fileUnit) 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 + read (fileUnit,'(A300)',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 + read (fileUnit,'(A300)',END=670) line ! skip crap line do i=1_pInt,mesh_Nnodes - read (fileUnit,610,END=670) line + read (fileUnit,'(A300)',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) @@ -1325,15 +1315,15 @@ subroutine mesh_marc_count_cpSizes(fileUnit) mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt -610 FORMAT(A300) + rewind(fileUnit) do - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',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 + read (fileUnit,'(A300)',END=630) line ! Garbage line do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',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 @@ -1381,16 +1371,15 @@ subroutine mesh_marc_build_elements(fileUnit) 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 + read (fileUnit,'(A300)',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 + read (fileUnit,'(A300)',END=620) line ! garbage line do i = 1_pInt,mesh_Nelems - read (fileUnit,610,END=620) line + 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 @@ -1406,7 +1395,7 @@ subroutine mesh_marc_build_elements(fileUnit) 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 + read (fileUnit,'(A300)',END=620) line chunkPos = IO_stringPos(line) do j = 1_pInt,chunkPos(1) mesh_element(4_pInt+nNodesAlreadyRead+j,e) & @@ -1421,23 +1410,23 @@ subroutine mesh_marc_build_elements(fileUnit) enddo 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',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 + 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,610,END=620) line ! read line with value of state var + read (fileUnit,'(A300)',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 if (initialcondTableStyle == 2_pInt) then - read (fileUnit,610,END=630) line ! read extra line - read (fileUnit,610,END=630) line ! read extra line + 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,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) @@ -1446,12 +1435,12 @@ subroutine mesh_marc_build_elements(fileUnit) 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 + read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo endif else - read (fileUnit,610,END=630) line + read (fileUnit,'(A300)',END=630) line endif enddo @@ -1482,7 +1471,7 @@ use IO, only: & rewind(fileUnit) do - read (fileUnit,610,END=620) line + read (fileUnit,'(A300)',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 @@ -1499,7 +1488,6 @@ use IO, only: & endif enddo -610 FORMAT(A300) 620 end subroutine mesh_get_damaskOptions From 16cb9ebed9037f1f0d7751fb8e208fce3d0d04d1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 16:49:12 +0100 Subject: [PATCH 45/92] no need to read homogenization info extra but currently, it is not very elegant --- src/mesh_grid.f90 | 89 ++++++----------------------------------------- 1 file changed, 11 insertions(+), 78 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index d3741b766..ec45b8def 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -124,7 +124,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & mesh_build_FEdata, & - mesh_spectral_getHomogenization, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & @@ -243,13 +242,11 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) call theMesh%init(mesh_node) - - ! For compatibility + 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 theMesh%setNelems(product(grid(1:2))*grid3) call mesh_spectral_build_elements() - if (myDebug) write(6,'(a)') ' Built elements'; flush(6) @@ -283,7 +280,6 @@ call theMesh%setNelems(product(grid(1:2))*grid3) ! for a homogeneous mesh, all elements have the same number of IPs and and cell nodes. ! hence, xxPerElem instead of maxXX ! better name - mesh_homogenizationAt = mesh_element(3,:) mesh_microstructureAt = mesh_element(4,:) !!!!!!!!!!!!!!!!!!!!!!!! deallocate(mesh_cell) @@ -407,6 +403,7 @@ subroutine mesh_spectral_read_grid() 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 @@ -419,10 +416,10 @@ subroutine mesh_spectral_read_grid() l = l + 1_pInt chunkPos = IO_stringPos(trim(line)) - possibleCompression: if (chunkPos(1) /= 3) then + 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 possibleCompression + 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))] @@ -434,7 +431,7 @@ subroutine mesh_spectral_read_grid() 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 possibleCompression + endif noCompression e = e+c end do @@ -444,64 +441,6 @@ subroutine mesh_spectral_read_grid() end subroutine mesh_spectral_read_grid -!-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_spectral_getHomogenization() - 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), allocatable, dimension(:) :: chunkPos - integer(pInt) :: headerLength = 0_pInt - character(len=1024) :: line, & - keyword - integer(pInt) :: i, myFileUnit - logical :: gotHomogenization = .false. - - myFileUnit = 289_pInt - call IO_open_file(myFileUnit,trim(geometryFile)) - - - 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 - - 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 Store x,y,z coordinates of all nodes in mesh. !! Allocates global arrays 'mesh_node0' and 'mesh_node' @@ -542,24 +481,18 @@ subroutine mesh_spectral_build_elements() implicit none integer(pInt) :: & e, & - - homog, & elemOffset - homog = mesh_spectral_getHomogenization() - - 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 (or blank line!) + 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) = homog ! homogenization + 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 @@ -587,7 +520,7 @@ subroutine mesh_spectral_build_ipNeighborhood integer(pInt) :: & x,y,z, & e - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems),source=0_pInt) + 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 @@ -988,8 +921,8 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), source=0.0_pReal) + 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 From abedb5c3db5bcb909d1f36ade2e7566cfa27f80a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 17:24:00 +0100 Subject: [PATCH 46/92] ordered according to calling sequence --- src/mesh_grid.f90 | 2 +- src/mesh_marc.f90 | 1468 +++++++++++++++++++++++---------------------- 2 files changed, 738 insertions(+), 732 deletions(-) diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index ec45b8def..d55c1cded 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -27,7 +27,7 @@ module mesh mesh_microstructureAt !< microstructure ID of each element integer(pInt), dimension(:,:), allocatable, public, protected :: & - mesh_element !< entryCount and list of elements containing node + 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] diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index d39f4efdb..da62a3e73 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -373,7 +373,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & FE_mapElemtype, & - mesh_faceMatch, & mesh_build_FEdata, & mesh_build_nodeTwins, & mesh_build_sharedElems, & @@ -562,53 +561,651 @@ end subroutine mesh_init !-------------------------------------------------------------------------------------------------- -!> @brief Gives the FE to CP ID mapping by binary search through lookup array -!! valid questions (what) are 'elem', 'node' +!> @brief Figures out version of Marc input file format and stores ist as MarcVersion !-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_FEasCP(what,myID) +subroutine mesh_marc_get_fileFormat(fileUnit) use IO, only: & - IO_lc + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos 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 - 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) + rewind(fileUnit) + do + read (fileUnit,'(A300)',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 binarySearch + 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 + + + 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 + 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 + + + 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(Marc_matNumber(data_blocks)) + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,'(A300)',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,'(A300)') 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 + + + rewind(fileUnit) + do + read (fileUnit,'(A300)',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,'(A300)') 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 + + + 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 + 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) + + + 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 + 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 + + + rewind(fileUnit) + if (MarcVersion < 13) then ! Marc 2016 or earlier + do + read (fileUnit,'(A300)',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,'(A300)') 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,'(A300)',END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,'(A300)') 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) + + + 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+hypoelasticTableStyle ! skip three (or four if new table style!) lines + read (fileUnit,'(A300)') 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,'(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. +!! 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) + + + 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,mesh_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. +!! 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) + + + 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' +!-------------------------------------------------------------------------------------------------- +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 + + + 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 + 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 + + + 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 < FE_Nnodes(t)) ! 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=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,'(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=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 + 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,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,'(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(fileUnit) + +use IO, only: & + IO_lc, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) chunk, Nchunks + character(len=300) :: line, damaskOption, v + character(len=300) :: keyword + + mesh_periodicSurface = .false. + keyword = '$damask' + + rewind(fileUnit) + do + read (fileUnit,'(A300)',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 + + +620 end subroutine mesh_get_damaskOptions -end function mesh_FEasCP !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -847,649 +1444,7 @@ pure function mesh_cellCenterCoordinates(ip,el) end function mesh_cellCenterCoordinates -!-------------------------------------------------------------------------------------------------- -!> @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 - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',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 - - - 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 - 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 - - - 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,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 - - - rewind(fileUnit) - do - read (fileUnit,'(A300)',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 - - - 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 - 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) - - - 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 - 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 - - - rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,'(A300)',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,'(A300)',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,'(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 - 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) - - - 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+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,'(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. -!! 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) - - - 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)',END=650) line ! skip crap line - do i = 1_pInt,mesh_Nnodes - read (fileUnit,'(A300)',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) - - - 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)',END=670) line ! skip crap line - do i=1_pInt,mesh_Nnodes - read (fileUnit,'(A300)',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 - - - 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)',END=630) line ! Garbage line - do i=1_pInt,mesh_Nelems ! read all elements - read (fileUnit,'(A300)',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 - - - 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 < FE_Nnodes(t)) ! 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=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,'(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=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 - 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,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,'(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(fileUnit) - -use IO, only: & - IO_lc, & - IO_stringValue, & - IO_stringPos - - implicit none - integer(pInt), intent(in) :: fileUnit - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword - - mesh_periodicSurface = .false. - keyword = '$damask' - - rewind(fileUnit) - do - read (fileUnit,'(A300)',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 - - -620 end subroutine mesh_get_damaskOptions !-------------------------------------------------------------------------------------------------- @@ -1865,57 +1820,10 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - -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 - - -!-------------------------------------------------------------------------------------------------- + + contains + + !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) @@ -2001,6 +1909,54 @@ 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 @@ -2719,4 +2675,54 @@ subroutine mesh_build_FEdata 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 From 35c37ef9dcdff9b3bdfb6b25222b6f04def01135 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 17:37:25 +0100 Subject: [PATCH 47/92] forgotten format specifier --- src/mesh_marc.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index da62a3e73..bc6dbf133 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -1130,7 +1130,7 @@ subroutine mesh_marc_build_elements(fileUnit) 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 + if (initialcondTableStyle == 2_pInt) read (fileUnit,'(A300)',END=620) 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 @@ -1149,7 +1149,7 @@ subroutine mesh_marc_build_elements(fileUnit) 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 + if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=620) line ! ignore IP range for old table style read (fileUnit,'(A300)',END=630) line chunkPos = IO_stringPos(line) enddo From bb135463c43a81f271325dd1388c486482159b9c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 20:45:19 +0100 Subject: [PATCH 48/92] using data from theMesh instead of local variables --- src/mesh_marc.f90 | 46 +++++++++++++++++++++------------------------- 1 file changed, 21 insertions(+), 25 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index bc6dbf133..a5dede809 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -515,8 +515,8 @@ subroutine mesh_init(ip,el) 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_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) @@ -1126,7 +1126,7 @@ subroutine mesh_marc_build_elements(fileUnit) 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" read (fileUnit,'(A300)',END=620) line - do + do !ToDo: the jumps to 620 in below code might result in a never ending loop 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 @@ -1206,7 +1206,6 @@ use IO, only: & 620 end subroutine mesh_get_damaskOptions - !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. !> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). @@ -1221,31 +1220,28 @@ subroutine mesh_build_cellconnectivity matchingNode2cellnode integer(pInt), dimension(:,:), allocatable :: & cellnodeParent - integer(pInt), dimension(mesh_maxNcellnodes) :: & + integer(pInt), dimension(theMesh%elem%Ncellnodes) :: & localCellnode2globalCellnode integer(pInt) :: & - e,t,g,c,n,i, & + e,n,i, & matchingNodeID, & localCellnodeID - allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) - allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_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 - mesh_Ncells = 0_pInt - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + + do e = 1_pInt,theMesh%nElems localCellnode2globalCellnode = 0_pInt - mesh_Ncells = mesh_Ncells + FE_Nips(g) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell - localCellnodeID = FE_cell(n,i,g) - if (localCellnodeID <= FE_NmatchingNodes(g)) then ! this cell node is a matching node + 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 ... @@ -1269,6 +1265,7 @@ subroutine mesh_build_cellconnectivity 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) @@ -1290,23 +1287,22 @@ function mesh_build_cellnodes(nodes,Ncellnodes) real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes integer(pInt) :: & - e,t,n,m, & + e,n,m, & localCellnodeID real(pReal), dimension(3) :: & myCoords mesh_build_cellnodes = 0.0_pReal -!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) +!$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) - t = mesh_element(2,e) ! get element type myCoords = 0.0_pReal - do m = 1_pInt,FE_Nnodes(t) + do m = 1_pInt,theMesh%elem%nNodes myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & - * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + * theMesh%elem%cellNodeParentNodeWeights(m,localCellnodeID) enddo - mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + mesh_build_cellnodes(1:3,n) = myCoords / sum(theMesh%elem%cellNodeParentNodeWeights(:,localCellnodeID)) enddo !$OMP END PARALLEL DO From 1eb30f3ae7506dc4a100a25ec036322e3ed1eb3b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 2 Feb 2019 20:49:15 +0100 Subject: [PATCH 49/92] re-ordered according to calling sequence --- src/mesh_abaqus.f90 | 667 ++++++++++++++++++++++---------------------- 1 file changed, 339 insertions(+), 328 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 909ab1e0e..20fef4098 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -570,291 +570,10 @@ logical function hasNoPart(fileUnit) end subroutine mesh_init -!-------------------------------------------------------------------------------------------------- -!> @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 -!-------------------------------------------------------------------------------------------------- -!> @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(mesh_maxNcellnodes) :: & - localCellnode2globalCellnode - integer(pInt) :: & - e,t,g,c,n,i, & - matchingNodeID, & - localCellnodeID - - allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) - allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) - allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) - -!-------------------------------------------------------------------------------------------------- -! Count cell nodes (including duplicates) and generate cell connectivity list - mesh_Ncellnodes = 0_pInt - mesh_Ncells = 0_pInt - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - localCellnode2globalCellnode = 0_pInt - mesh_Ncells = mesh_Ncells + FE_Nips(g) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell - localCellnodeID = FE_cell(n,i,g) - if (localCellnodeID <= FE_NmatchingNodes(g)) 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,t,n,m, & - localCellnodeID - real(pReal), dimension(3) :: & - myCoords - - mesh_build_cellnodes = 0.0_pReal -!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) - do n = 1_pInt,Ncellnodes ! loop over cell nodes - e = mesh_cellnodeParent(1,n) - localCellnodeID = mesh_cellnodeParent(2,n) - t = mesh_element(2,e) ! get element type - myCoords = 0.0_pReal - do m = 1_pInt,FE_Nnodes(t) - myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & - * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) - enddo - mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) - 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(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 - t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - select case (c) - - case (1_pInt) ! 2D 3node - forall (i = 1_pInt:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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,FE_Nips(g) ! 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,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) - - !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) - do e = 1_pInt,mesh_NcpElems ! loop over cpElems - t = mesh_element(2_pInt,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=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) :: t,g,c,n - - t = mesh_element(2_pInt,el) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type - 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 !-------------------------------------------------------------------------------------------------- @@ -1548,7 +1267,6 @@ subroutine mesh_abaqus_build_elements(fileUnit) end subroutine mesh_abaqus_build_elements - !-------------------------------------------------------------------------------------------------- !> @brief get any additional damask options from input file, sets mesh_periodicSurface !-------------------------------------------------------------------------------------------------- @@ -1594,6 +1312,246 @@ use IO, only: & 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(mesh_maxNcellnodes) :: & + localCellnode2globalCellnode + integer(pInt) :: & + e,t,g,c,n,i, & + matchingNodeID, & + localCellnodeID + + allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) + allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) + allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) + +!-------------------------------------------------------------------------------------------------- +! Count cell nodes (including duplicates) and generate cell connectivity list + mesh_Ncellnodes = 0_pInt + mesh_Ncells = 0_pInt + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + localCellnode2globalCellnode = 0_pInt + mesh_Ncells = mesh_Ncells + FE_Nips(g) + do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + localCellnodeID = FE_cell(n,i,g) + if (localCellnodeID <= FE_NmatchingNodes(g)) 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,t,n,m, & + localCellnodeID + real(pReal), dimension(3) :: & + myCoords + + mesh_build_cellnodes = 0.0_pReal +!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) + do n = 1_pInt,Ncellnodes ! loop over cell nodes + e = mesh_cellnodeParent(1,n) + localCellnodeID = mesh_cellnodeParent(2,n) + t = mesh_element(2,e) ! get element type + myCoords = 0.0_pReal + do m = 1_pInt,FE_Nnodes(t) + myCoords = myCoords + nodes(1:3,mesh_element(4_pInt+m,e)) & + * FE_cellnodeParentnodeWeights(m,localCellnodeID,t) + enddo + mesh_build_cellnodes(1:3,n) = myCoords / sum(FE_cellnodeParentnodeWeights(:,localCellnodeID,t)) + 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(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 + t = mesh_element(2_pInt,e) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + select case (c) + + case (1_pInt) ! 2D 3node + forall (i = 1_pInt:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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:FE_Nips(g)) & ! 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,FE_Nips(g) ! 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,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + + !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) + do e = 1_pInt,mesh_NcpElems ! loop over cpElems + t = mesh_element(2_pInt,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=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) :: t,g,c,n + + t = mesh_element(2_pInt,el) ! get element type + g = FE_geomtype(t) ! get geometry type + c = FE_celltype(g) ! get cell type + 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' @@ -1968,52 +1926,9 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - -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 - - -!-------------------------------------------------------------------------------------------------- + + contains + !-------------------------------------------------------------------------------------------------- !> @brief find face-matching element of same type !-------------------------------------------------------------------------------------------------- subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) @@ -2099,6 +2014,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 @@ -2817,4 +2778,54 @@ subroutine mesh_build_FEdata 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 From a92937a7e35af212e19fabd662cbacc42f65e3c0 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:06:53 +0100 Subject: [PATCH 50/92] grid does reading in of geometry independently --- src/IO.f90 | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index bef14ea1e..29c27c567 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -44,18 +44,22 @@ module IO IO_lc, & IO_skipChunks, & IO_extractValue, & - IO_countDataLines, & - IO_countNumericalDataLines, & - IO_countContinuousIntValues, & - IO_continuousIntValues, & IO_error, & IO_warning, & IO_intOut, & IO_timeStamp #if defined(Marc4DAMASK) || defined(Abaqus) public :: & +#ifdef Abaqus + IO_countDataLines, & +#endif +#ifdef Marc4DAMASK + IO_countNumericalDataLines, & +#endif IO_open_inputFile, & - IO_open_logFile + IO_open_logFile, & + IO_countContinuousIntValues, & + IO_continuousIntValues #endif private :: & IO_fixedFloatValue, & @@ -889,6 +893,7 @@ character(len=300) pure function IO_extractValue(pair,key) end function IO_extractValue +#ifdef Abaqus !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- @@ -919,8 +924,10 @@ integer(pInt) function IO_countDataLines(fileUnit) backspace(fileUnit) end function IO_countDataLines +#endif +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief count lines containig data up to next *keyword !-------------------------------------------------------------------------------------------------- @@ -951,12 +958,14 @@ integer(pInt) function IO_countNumericalDataLines(fileUnit) backspace(fileUnit) end function IO_countNumericalDataLines +#endif + +#if defined(Abaqus) || defined(Marc4DAMASK) !-------------------------------------------------------------------------------------------------- !> @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) @@ -972,7 +981,7 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) IO_countContinuousIntValues = 0_pInt line = '' -#ifndef Abaqus +#if defined(Marc4DAMASK) do while (trim(line) /= IO_EOF) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) @@ -983,11 +992,7 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) 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 + 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 @@ -997,14 +1002,14 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) endif endif enddo -#else +#elif defined(Abaqus) c = IO_countDataLines(fileUnit) do l = 1_pInt,c - backspace(fileUnit) ! ToDo: substitute by rewind? + backspace(fileUnit) enddo l = 1_pInt - do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct + 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) @@ -1022,7 +1027,6 @@ end function IO_countContinuousIntValues !! 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) @@ -1046,7 +1050,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) IO_continuousIntValues = 0_pInt rangeGeneration = .false. -#ifndef Abaqus +#if defined(Marc4DAMASK) do read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) @@ -1068,10 +1072,6 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) 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 @@ -1084,7 +1084,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) endif endif enddo -#else +#elif defined(Abaqus) c = IO_countDataLines(fileUnit) do l = 1_pInt,c backspace(fileUnit) @@ -1130,6 +1130,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) #endif 100 end function IO_continuousIntValues +#endif !-------------------------------------------------------------------------------------------------- From 40ad1aef2f12fbcad4932f3dcf205c1dd458d52f Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:07:58 +0100 Subject: [PATCH 51/92] was not used --- src/IO.f90 | 20 -------------------- 1 file changed, 20 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 29c27c567..b4f9d1de9 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -62,7 +62,6 @@ module IO IO_continuousIntValues #endif private :: & - IO_fixedFloatValue, & IO_verifyFloatValue, & IO_verifyIntValue @@ -733,25 +732,6 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk) end function IO_floatValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads float value at myChunk from fixed format string -!-------------------------------------------------------------------------------------------------- -real(pReal) function IO_fixedFloatValue (string,ends,myChunk) - - implicit none - character(len=*), intent(in) :: string !< raw input with known ends 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.+-' - - IO_fixedFloatValue = & - IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& - VALIDCHARACTERS,MYNAME) - -end function IO_fixedFloatValue - - !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string !-------------------------------------------------------------------------------------------------- From 2c7553653b6406c7d0d145ef12ba7d649a6203a4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:11:19 +0100 Subject: [PATCH 52/92] only used by MSC.Marc --- src/IO.f90 | 39 ++++++++++++++++++++------------------- 1 file changed, 20 insertions(+), 19 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index b4f9d1de9..fa98ae4df 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -731,7 +731,7 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk) end function IO_floatValue - +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string !-------------------------------------------------------------------------------------------------- @@ -765,6 +765,25 @@ real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) end function IO_fixedNoEFloatValue +!-------------------------------------------------------------------------------------------------- +!> @brief reads integer value at myChunk from fixed format string +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_fixedIntValue(string,ends,myChunk) + + implicit none + character(len=*), intent(in) :: string !< raw input with known ends 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_fixedIntValue: ' + character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' + + IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& + VALIDCHARACTERS,MYNAME) + +end function IO_fixedIntValue +#endif + + !-------------------------------------------------------------------------------------------------- !> @brief reads integer value at myChunk from string !-------------------------------------------------------------------------------------------------- @@ -789,24 +808,6 @@ integer(pInt) function IO_intValue(string,chunkPos,myChunk) end function IO_intValue -!-------------------------------------------------------------------------------------------------- -!> @brief reads integer value at myChunk from fixed format string -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_fixedIntValue(string,ends,myChunk) - - implicit none - character(len=*), intent(in) :: string !< raw input with known ends 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_fixedIntValue: ' - character(len=12), parameter :: VALIDCHARACTERS = '0123456789+-' - - IO_fixedIntValue = IO_verifyIntValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk+1_pInt)))),& - VALIDCHARACTERS,MYNAME) - -end function IO_fixedIntValue - - !-------------------------------------------------------------------------------------------------- !> @brief changes characters in string to lower case !-------------------------------------------------------------------------------------------------- From f45ba0ff5b4dbe809967a9be6237d0c036793781 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 08:18:38 +0100 Subject: [PATCH 53/92] functions specific for MSC.Marc and/or Abaqus these functions are very specific for the input files and might be better located in the respective mesh module --- src/IO.f90 | 564 ++++++++++++++++++++++++++--------------------------- 1 file changed, 276 insertions(+), 288 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index fa98ae4df..b5868fa48 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -36,14 +36,9 @@ module IO IO_getTag, & IO_stringPos, & IO_stringValue, & - IO_fixedStringValue ,& IO_floatValue, & - IO_fixedNoEFloatValue, & IO_intValue, & - IO_fixedIntValue, & IO_lc, & - IO_skipChunks, & - IO_extractValue, & IO_error, & IO_warning, & IO_intOut, & @@ -51,9 +46,13 @@ module IO #if defined(Marc4DAMASK) || defined(Abaqus) public :: & #ifdef Abaqus + IO_extractValue, & IO_countDataLines, & #endif #ifdef Marc4DAMASK + IO_skipChunks, & + IO_fixedNoEFloatValue, & + IO_fixedIntValue, & IO_countNumericalDataLines, & #endif IO_open_inputFile, & @@ -93,7 +92,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 @@ -161,6 +160,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 @@ -284,7 +284,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 @@ -691,22 +691,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 !-------------------------------------------------------------------------------------------------- @@ -731,6 +715,31 @@ real(pReal) function IO_floatValue (string,chunkPos,myChunk) end function IO_floatValue + +!-------------------------------------------------------------------------------------------------- +!> @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 + + #ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads float x.y+z value at myChunk from format string @@ -784,30 +793,6 @@ end function IO_fixedIntValue #endif -!-------------------------------------------------------------------------------------------------- -!> @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 changes characters in string to lower case !-------------------------------------------------------------------------------------------------- @@ -831,6 +816,7 @@ pure function IO_lc(string) end function IO_lc +#ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- !> @brief reads file to skip (at least) N chunks (may be over multiple lines) !-------------------------------------------------------------------------------------------------- @@ -851,8 +837,10 @@ subroutine IO_skipChunks(fileUnit,N) remainingChunks = remainingChunks - (size(IO_stringPos(line))-1_pInt)/2_pInt enddo end subroutine IO_skipChunks +#endif +#ifdef Abaqus !-------------------------------------------------------------------------------------------------- !> @brief extracts string value from key=value pair and check whether key matches !-------------------------------------------------------------------------------------------------- @@ -872,247 +860,7 @@ character(len=300) pure function IO_extractValue(pair,key) if (myChunk > 0 .and. pair(:myChunk-1) == key) IO_extractValue = pair(myChunk+1:) ! extract value if key matches end function IO_extractValue - - -#ifdef Abaqus -!-------------------------------------------------------------------------------------------------- -!> @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 -#endif - - -#if defined(Abaqus) || defined(Marc4DAMASK) -!-------------------------------------------------------------------------------------------------- -!> @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 - +# endif !-------------------------------------------------------------------------------------------------- !> @brief returns format string for integer values without leading zeros @@ -1503,6 +1251,246 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) end subroutine IO_warning +#ifdef Abaqus +!-------------------------------------------------------------------------------------------------- +!> @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 +#endif + + +#if defined(Abaqus) || defined(Marc4DAMASK) +!-------------------------------------------------------------------------------------------------- +!> @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 From d605adc92e222ec33c5ab02a11e4a386e3eb8943 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 11:12:23 +0100 Subject: [PATCH 54/92] avoid the use of global variables to make dependencies clear --- src/mesh_marc.f90 | 240 ++++++++++++++++++++++------------------------ 1 file changed, 117 insertions(+), 123 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index a5dede809..0421a9452 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -392,27 +392,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & type, public, extends(tMesh) :: tMesh_marc - integer(pInt), public :: & - nElemsAll, & - maxNelemInSet, & - NelemSets,& - MarcVersion, & !< Version of input file format ToDo: Better Name? - hypoelasticTableStyle, & !< Table style - initialcondTableStyle - character(len=64), dimension(:), allocatable :: & - nameElemSet,& !< names of elementSet - mesh_nameElemSet, & !< names of elementSet - mapMaterial !< name of elementSet for material - integer(pInt), dimension(:), allocatable :: & - Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) - 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 - integer(pInt), dimension(:,:), allocatable :: & - mesh_mapElemSet !< list of elements in elementSet - contains procedure, pass(self) :: tMesh_marc_init generic, public :: init => tMesh_marc_init @@ -467,9 +446,10 @@ subroutine mesh_init(ip,el) FEsolving_execIP implicit none - integer(pInt), parameter :: FILEUNIT = 222_pInt - integer(pInt), intent(in), optional :: el, ip - integer(pInt) :: j + integer(pInt), intent(in) :: el, ip + + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt) :: j, fileFormatVersion, elemType logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -483,38 +463,57 @@ subroutine mesh_init(ip,el) 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) + + MarcVersion = mesh_marc_get_fileFormat(FILEUNIT) + fileFormatVersion = MarcVersion if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) - call mesh_marc_get_tableStyles(FILEUNIT) + + call mesh_marc_get_tableStyles(initialcondTableStyle,hypoelasticTableStyle,FILEUNIT) if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) - if (MarcVersion > 12) then - call mesh_marc_get_matNumber(FILEUNIT) + + 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(FILEUNIT) + + 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(FILEUNIT) + + call mesh_marc_count_elementSets(mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Counted element sets'; flush(6) - call mesh_marc_map_elementSets(FILEUNIT) + + 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,& + mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - call mesh_marc_count_cpElements(FILEUNIT) + + mesh_NcpElems = mesh_marc_count_cpElements(hypoelasticTableStyle,Marc_matNumber,fileFormatVersion,FILEUNIT) if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) - call mesh_marc_map_elements(FILEUNIT) + + allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) + call mesh_marc_map_elements(FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) - call mesh_marc_map_nodes(FILEUNIT) + + allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) + call mesh_marc_map_nodes(FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped nodes'; flush(6) - call mesh_marc_build_nodes(FILEUNIT) + + call mesh_marc_build_nodes(FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Built nodes'; flush(6) - call mesh_marc_count_cpSizes(FILEUNIT) + + 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(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 @@ -561,9 +560,9 @@ end subroutine mesh_init !-------------------------------------------------------------------------------------------------- -!> @brief Figures out version of Marc input file format and stores ist as MarcVersion +!> @brief Figures out version of Marc input file format !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_fileFormat(fileUnit) +integer(pInt) function mesh_marc_get_fileFormat(fileUnit) use IO, only: & IO_lc, & IO_intValue, & @@ -583,19 +582,18 @@ subroutine mesh_marc_get_fileFormat(fileUnit) chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - MarcVersion = IO_intValue(line,chunkPos,2_pInt) + mesh_marc_get_fileFormat = IO_intValue(line,chunkPos,2_pInt) exit endif enddo -620 end subroutine mesh_marc_get_fileFormat +620 end function mesh_marc_get_fileFormat !-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and -!! 'hypoelasticTableStyle' +!> @brief Figures out table styles for initial cond and hypoelastic !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_tableStyles(fileUnit) +subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) use IO, only: & IO_lc, & IO_intValue, & @@ -603,14 +601,14 @@ subroutine mesh_marc_get_tableStyles(fileUnit) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: initialcond, hypoelastic + integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - initialcondTableStyle = 0_pInt - hypoelasticTableStyle = 0_pInt - + initialcond = 0_pInt + hypoelastic = 0_pInt rewind(fileUnit) do @@ -618,18 +616,19 @@ subroutine mesh_marc_get_tableStyles(fileUnit) 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) + 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 and stores it in Marc_matNumber array !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_get_matNumber(fileUnit) +function mesh_marc_get_matNumber(fileUnit,tableStyle) use IO, only: & IO_lc, & IO_intValue, & @@ -637,7 +636,8 @@ subroutine mesh_marc_get_matNumber(fileUnit) IO_stringPos implicit none - integer(pInt), intent(in) :: fileUnit + 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 @@ -657,12 +657,12 @@ subroutine mesh_marc_get_matNumber(fileUnit) 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 + 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) - 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 + 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 @@ -670,14 +670,14 @@ subroutine mesh_marc_get_matNumber(fileUnit) endif enddo -620 end subroutine mesh_marc_get_matNumber +620 end function 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) +subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) use IO, only: & IO_lc, & IO_stringValue, & @@ -685,14 +685,14 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) IO_IntValue implicit none - integer(pInt), intent(in) :: fileUnit - + integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: nNodes, nElems + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - mesh_Nnodes = 0_pInt - mesh_Nelems = 0_pInt - + nNodes = 0_pInt + nElems = 0_pInt rewind(fileUnit) do @@ -700,12 +700,12 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) chunkPos = IO_stringPos(line) if ( IO_lc(IO_StringValue(line,chunkPos,1_pInt)) == 'sizing') & - mesh_Nelems = IO_IntValue (line,chunkPos,3_pInt) + 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) - mesh_Nnodes = IO_IntValue (line,chunkPos,2_pInt) - exit ! assumes that "coordinates" comes later in file + nNodes = IO_IntValue (line,chunkPos,2_pInt) + exit ! assumes that "coordinates" comes later in file endif enddo @@ -713,10 +713,9 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) !-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of element sets in mesh. Stores to 'mesh_NelemSets', and -!! 'mesh_maxNelemInSet' +!> @brief Count overall number of element sets in mesh. !-------------------------------------------------------------------------------------------------- - subroutine mesh_marc_count_elementSets(fileUnit) + subroutine mesh_marc_count_elementSets(nElemSets,maxNelemInSet,fileUnit) use IO, only: & IO_lc, & IO_stringValue, & @@ -725,13 +724,13 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(out) :: nElemSets, maxNelemInSet integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) line - - mesh_NelemSets = 0_pInt - mesh_maxNelemInSet = 0_pInt + character(len=300) :: line + nElemSets = 0_pInt + maxNelemInSet = 0_pInt rewind(fileUnit) do @@ -740,21 +739,19 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) 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)) + nElemSets = nElemSets + 1_pInt + maxNelemInSet = max(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) +!-------------------------------------------------------------------------------------------------- +!> @brief map element sets +!! allocate globals: mesh_nameElemSet, mesh_mapElemSet +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemInSet,fileUnit) use IO, only: IO_lc, & IO_stringValue, & @@ -762,15 +759,17 @@ subroutine mesh_marc_map_elementSets(fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit,NelemSets,maxNelemInSet + character(len=64), dimension(mesh_NelemSets), intent(out) :: & + nameElemSet + integer(pInt), dimension(1_pInt+maxNelemInSet,NelemSets), intent(out) :: & + mapElemSet 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) - + integer(pInt) :: elemSet + + elemSet = 0_pInt rewind(fileUnit) do @@ -779,9 +778,8 @@ subroutine mesh_marc_map_elementSets(fileUnit) 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) + nameElemSet(elemSet) = trim(IO_stringValue(line,chunkPos,4_pInt)) + mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,maxNelemInSet,nameElemSet,mapElemSet,NelemSets) endif enddo @@ -791,7 +789,7 @@ subroutine mesh_marc_map_elementSets(fileUnit) !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpElements(fileUnit) +integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileFormatVersion,fileUnit) use IO, only: IO_lc, & IO_stringValue, & @@ -802,48 +800,48 @@ subroutine mesh_marc_count_cpElements(fileUnit) IO_countNumericalDataLines implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit, tableStyle,fileFormatVersion + integer(pInt), dimension(:), intent(in) :: matNumber integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: i character(len=300):: line - mesh_NcpElems = 0_pInt + mesh_marc_count_cpElements = 0_pInt rewind(fileUnit) - if (MarcVersion < 13) then ! Marc 2016 or earlier + if (fileFormatVersion < 13) then ! Marc 2016 or earlier do read (fileUnit,'(A300)',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 + do i=1_pInt,3_pInt+tableStyle ! Skip 3 or 4 lines read (fileUnit,'(A300)') 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 + mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countContinuousIntValues(fileUnit) exit endif enddo - else ! Marc2017 and later + else ! Marc2017 and later 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)') line chunkPos = IO_stringPos(line) - if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + if (any(matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countNumericalDataLines(fileUnit) endif endif enddo end if -620 end subroutine mesh_marc_count_cpElements +620 end function 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) @@ -864,24 +862,21 @@ subroutine mesh_marc_map_elements(fileUnit) integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts integer(pInt) :: i,cpElem = 0_pInt - allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 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 (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 + do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines read (fileUnit,'(A300)') line enddo contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& mesh_mapElemSet,mesh_NelemSets) exit endif - else ! Marc2017 and later + 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) @@ -890,7 +885,7 @@ subroutine mesh_marc_map_elements(fileUnit) 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 + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword exit else contInts(1) = contInts(1) + 1_pInt @@ -907,14 +902,13 @@ subroutine mesh_marc_map_elements(fileUnit) mesh_mapFEtoCPelem(2,cpElem) = cpElem enddo -call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems +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) @@ -933,9 +927,6 @@ subroutine mesh_marc_map_nodes(fileUnit) integer(pInt), dimension (mesh_Nnodes) :: node_count integer(pInt) :: i - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) - - node_count = 0_pInt rewind(fileUnit) @@ -943,10 +934,10 @@ subroutine mesh_marc_map_nodes(fileUnit) 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 + read (fileUnit,'(A300)') line ! skip crap line do i = 1_pInt,mesh_Nnodes read (fileUnit,'(A300)') line - mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[ 0_pInt,10_pInt],1_pInt) + mesh_mapFEtoCPnode(1_pInt,i) = IO_fixedIntValue (line,[0_pInt,10_pInt],1_pInt) mesh_mapFEtoCPnode(2_pInt,i) = i enddo exit @@ -988,7 +979,7 @@ subroutine mesh_marc_build_nodes(fileUnit) 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 + 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)) @@ -1010,9 +1001,10 @@ end subroutine mesh_marc_build_nodes !! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', !! and 'mesh_maxNcellnodes' !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_count_cpSizes(fileUnit) +integer(pInt) function mesh_marc_count_cpSizes(fileUnit) use IO, only: IO_lc, & + IO_error, & IO_stringValue, & IO_stringPos, & IO_intValue, & @@ -1029,20 +1021,22 @@ subroutine mesh_marc_count_cpSizes(fileUnit) mesh_maxNips = 0_pInt mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt - + 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 + 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 e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then - t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + if (t == -1_pInt) t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message + mesh_marc_count_cpSizes = t g = FE_geomtype(t) c = FE_celltype(g) mesh_maxNnodes = max(mesh_maxNnodes,FE_Nnodes(t)) @@ -1056,7 +1050,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) endif enddo -630 end subroutine mesh_marc_count_cpSizes +630 end function mesh_marc_count_cpSizes !-------------------------------------------------------------------------------------------------- From b9f93d5460d74c564f42f39d54f11cd1091a41cf Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 11:22:23 +0100 Subject: [PATCH 55/92] is now a subfunction --- src/mesh_abaqus.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 20fef4098..05a4a71af 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -367,7 +367,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_build_cellconnectivity, & mesh_build_ipAreas, & FE_mapElemtype, & - mesh_faceMatch, & mesh_build_FEdata, & mesh_build_nodeTwins, & mesh_build_sharedElems, & From 91992debf292233c1a36080ca76e8aba7b216ee1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 13:30:04 +0100 Subject: [PATCH 56/92] Marc now works also with the module reason, why it did NOT work earlier still not clear --- src/numerics.f90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) 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 From 2aba6faf4086a4c9b9c7558149ef8d135ed25d3a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 12:28:04 +0100 Subject: [PATCH 57/92] cleaning and making dependencies clear --- src/mesh_abaqus.f90 | 21 ++++++++++----------- src/mesh_marc.f90 | 21 ++++++++++----------- 2 files changed, 20 insertions(+), 22 deletions(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 05a4a71af..89f0eed06 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -490,7 +490,7 @@ 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) - call mesh_get_damaskOptions(FILEUNIT) + call mesh_get_damaskOptions(mesh_periodic_surface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) @@ -1269,7 +1269,7 @@ end subroutine mesh_abaqus_build_elements !-------------------------------------------------------------------------------------------------- !> @brief get any additional damask options from input file, sets mesh_periodicSurface !-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) +subroutine mesh_get_damaskOptions(periodic_surface,fileUnit) use IO, only: & IO_lc, & @@ -1282,24 +1282,23 @@ use IO, only: & integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer :: myStat - logical :: inPart - integer(pInt) chunk, Nchunks - character(len=300) :: damaskOption, v - character(len=*), parameter :: keyword = '**damask' + integer(pInt) :: chunk, Nchunks + character(len=300) :: v + logical, dimension(3) :: periodic_surface + - mesh_periodicSurface = .false. + 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)) == 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) + 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? + 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' diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 0421a9452..506f6a107 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -484,8 +484,7 @@ subroutine mesh_init(ip,el) 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,& - mesh_NelemSets,mesh_maxNelemInSet,FILEUNIT) + call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) mesh_NcpElems = mesh_marc_count_cpElements(hypoelasticTableStyle,Marc_matNumber,fileFormatVersion,FILEUNIT) @@ -500,6 +499,7 @@ subroutine mesh_init(ip,el) 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) @@ -626,7 +626,7 @@ subroutine mesh_marc_get_tableStyles(initialcond, hypoelastic,fileUnit) !-------------------------------------------------------------------------------------------------- -!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!> @brief Figures out material number of hypoelastic material !-------------------------------------------------------------------------------------------------- function mesh_marc_get_matNumber(fileUnit,tableStyle) use IO, only: & @@ -751,7 +751,7 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) !> @brief map element sets !! allocate globals: mesh_nameElemSet, mesh_mapElemSet !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemInSet,fileUnit) +subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) use IO, only: IO_lc, & IO_stringValue, & @@ -759,10 +759,10 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemIn IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,NelemSets,maxNelemInSet - character(len=64), dimension(mesh_NelemSets), intent(out) :: & + integer(pInt), intent(in) :: fileUnit,NelemSets + character(len=64), dimension(:), intent(out) :: & nameElemSet - integer(pInt), dimension(1_pInt+maxNelemInSet,NelemSets), intent(out) :: & + integer(pInt), dimension(:,:), intent(out) :: & mapElemSet integer(pInt), allocatable, dimension(:) :: chunkPos @@ -779,7 +779,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,NelemSets,maxNelemIn (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,maxNelemInSet,nameElemSet,mapElemSet,NelemSets) + mapElemSet(:,elemSet) = IO_continuousIntValues(fileUnit,size(mapElemSet,1)-1,nameElemSet,mapElemSet,size(nameElemSet)) endif enddo @@ -860,8 +860,9 @@ subroutine mesh_marc_map_elements(fileUnit) tmp integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts - integer(pInt) :: i,cpElem = 0_pInt + integer(pInt) :: i,cpElem + cpElem = 0_pInt contInts = 0_pInt rewind(fileUnit) do @@ -971,8 +972,6 @@ subroutine mesh_marc_build_nodes(fileUnit) 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) - rewind(fileUnit) do From 2d0c74d7d9257d80ba4c4976bbfbecd312dbe4fd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 12:54:10 +0100 Subject: [PATCH 58/92] implicit dependencies made explicit --- src/mesh_marc.f90 | 58 +++++++++++++++++++++++------------------------ 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 506f6a107..4e4adbc36 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -61,7 +61,6 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) integer(pInt), private :: & - mesh_maxNelemInSet, & mesh_Nmaterials integer(pInt), dimension(:,:), allocatable, private :: & @@ -342,9 +341,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_maxNnodes, & !< max number of nodes in any CP element mesh_NelemSets character(len=64), dimension(:), allocatable, private :: & - mesh_nameElemSet, & !< names of elementSet - mesh_nameMaterial, & !< names of material in solid section - mesh_mapMaterial !< name of elementSet for material + mesh_nameElemSet + integer(pInt), dimension(:,:), allocatable, private :: & mesh_mapElemSet !< list of elements in elementSet integer(pInt), dimension(:,:), allocatable, target, private :: & @@ -450,6 +448,8 @@ subroutine mesh_init(ip,el) integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt) :: j, fileFormatVersion, elemType + integer(pInt) :: & + mesh_maxNelemInSet logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -491,7 +491,7 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) - call mesh_marc_map_elements(FILEUNIT) !ToDo: don't work on global variables + call mesh_marc_map_elements(hypoelasticTableStyle,mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) !ToDo: don't work on global variables if (myDebug) write(6,'(a)') ' Mapped elements'; flush(6) allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes),source=0_pInt) @@ -510,7 +510,7 @@ subroutine mesh_init(ip,el) call mesh_marc_build_elements(FILEUNIT) if (myDebug) write(6,'(a)') ' Built elements'; flush(6) - call mesh_get_damaskOptions(FILEUNIT) + call mesh_get_damaskOptions(mesh_periodicSurface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) @@ -674,8 +674,7 @@ function mesh_marc_get_matNumber(fileUnit,tableStyle) !-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of nodes and elements in mesh and stores the numbers in -!! 'mesh_Nelems' and 'mesh_Nnodes' +!> @brief Count overall number of nodes and elements !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) use IO, only: & @@ -749,7 +748,6 @@ subroutine mesh_marc_count_nodesAndElements(nNodes, nElems, fileUnit) !-------------------------------------------------------------------------------------------------- !> @brief map element sets -!! allocate globals: mesh_nameElemSet, mesh_mapElemSet !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) @@ -843,7 +841,7 @@ integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileForma !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(fileUnit) +subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) use math, only: math_qsort use IO, only: IO_lc, & @@ -853,7 +851,10 @@ subroutine mesh_marc_map_elements(fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit,tableStyle + character(len=64), intent(in), dimension(:) :: nameElemSet + integer(pInt), dimension(:,:), intent(in) :: & + mapElemSet integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line, & @@ -870,11 +871,11 @@ subroutine mesh_marc_map_elements(fileUnit) 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 + 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,mesh_NcpElems,mesh_nameElemSet,& - mesh_mapElemSet,mesh_NelemSets) + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,nameElemSet,& + mapElemSet,size(nameElemSet)) exit endif else ! Marc2017 and later @@ -1158,7 +1159,7 @@ subroutine mesh_marc_build_elements(fileUnit) !-------------------------------------------------------------------------------------------------- !> @brief get any additional damask options from input file, sets mesh_periodicSurface !-------------------------------------------------------------------------------------------------- -subroutine mesh_get_damaskOptions(fileUnit) +subroutine mesh_get_damaskOptions(periodic_surface,fileUnit) use IO, only: & IO_lc, & @@ -1168,23 +1169,23 @@ use IO, only: & implicit none integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) chunk, Nchunks - character(len=300) :: line, damaskOption, v - character(len=300) :: keyword - - mesh_periodicSurface = .false. - keyword = '$damask' + 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 - read (fileUnit,'(A300)',END=620) line + 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)) == 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) + 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? @@ -1196,8 +1197,7 @@ use IO, only: & endif enddo - -620 end subroutine mesh_get_damaskOptions +end subroutine mesh_get_damaskOptions !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. From ec23fca05779f07b7e286baa74c873d66d79d270 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 14:21:42 +0100 Subject: [PATCH 59/92] it's a property of the element, not of the mesh --- src/plastic_nonlocal.f90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index e8562e55e..ef1dac3d9 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -234,8 +234,7 @@ use IO, only: IO_read, & use debug, only: debug_level, & debug_constitutive, & debug_levelBasic -use mesh, only: theMesh, & - mesh_maxNipNeighbors +use mesh, only: theMesh use material, only: phase_plasticity, & homogenization_maxNgrains, & phase_plasticityInstance, & @@ -829,7 +828,7 @@ allocate(rhoDotThermalAnnihilationOutput(maxTotalNslip,2,homogenization_maxNgrai allocate(rhoDotEdgeJogsOutput(maxTotalNslip,homogenization_maxNgrains,theMesh%elem%nIPs,theMesh%nElems), & source=0.0_pReal) -allocate(compatibility(2,maxTotalNslip,maxTotalNslip,mesh_maxNipNeighbors,theMesh%elem%nIPs,theMesh%nElems), & +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) From b0b1ea3b842dc7736ea2f9aa54699f61fd049d98 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 14:23:32 +0100 Subject: [PATCH 60/92] input argument not needed any more --- src/mesh_marc.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 4e4adbc36..8c53c5a2d 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -757,7 +757,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,NelemSets + integer(pInt), intent(in) :: fileUnit character(len=64), dimension(:), intent(out) :: & nameElemSet integer(pInt), dimension(:,:), intent(out) :: & From 59dd9b16e1915841417ad00378ffc7086a4feb43 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 16:40:15 +0100 Subject: [PATCH 61/92] cleaning --- src/DAMASK_marc.f90 | 6 +- src/mesh_marc.f90 | 967 ++++---------------------------------------- 2 files changed, 85 insertions(+), 888 deletions(-) diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 0c7d1adeb..d33cdd4cc 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -134,6 +134,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 +142,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 +314,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/mesh_marc.f90 b/src/mesh_marc.f90 index 8c53c5a2d..a269b60e4 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -13,18 +13,11 @@ module mesh implicit none private integer(pInt), public, protected :: & - mesh_NcpElems, & !< total number of CP elements in local mesh 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_maxNipNeighbors, & !< max number of IP neighbors in any CP element mesh_maxNsharedElems !< max number of CP elements sharing a node -!!!! BEGIN DEPRECATED !!!!! - integer(pInt), public, protected :: & - mesh_maxNips, & !< max number of IPs in any CP element - mesh_maxNcellnodes !< max number of cell nodes in any CP element -!!!! BEGIN DEPRECATED !!!!! integer(pInt), dimension(:), allocatable, public, protected :: & mesh_homogenizationAt, & !< homogenization ID of each element @@ -70,16 +63,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell integer(pInt), dimension(:,:,:), allocatable, private :: & - FE_nodesAtIP, & !< map IP index to node indices in a specific type of element - FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element - FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell - real(pReal), dimension(:,:,:), allocatable, private :: & - FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes - - integer(pInt), dimension(:,:,:,:), allocatable, private :: & - FE_subNodeOnIPFace ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) ! Hence, I suggest to prefix with "FE_" @@ -88,8 +73,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & FE_Nelemtypes = 13_pInt, & FE_Ngeomtypes = 10_pInt, & FE_Ncelltypes = 4_pInt, & - FE_maxNnodes = 20_pInt, & - FE_maxNips = 27_pInt, & FE_maxNipNeighbors = 6_pInt, & FE_maxmaxNnodesAtIP = 8_pInt, & !< max number of (equivalent) nodes attached to an IP FE_maxNmatchingNodesPerFace = 4_pInt, & @@ -99,69 +82,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & FE_maxNcellfaces = 6_pInt, & FE_maxNcellnodesPerCellface = 4_pInt - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 3, & ! element 11 (2D 4node 4ip) - 4, & ! element 27 (2D 8node 9ip) - 3, & ! element 54 (2D 8node 4ip) - 5, & ! element 134 (3D 4node 1ip) - 6, & ! element 157 (3D 5node 4ip) - 6, & ! element 127 (3D 10node 4ip) - 7, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 9, & ! element 7 (3D 8node 8ip) - 9, & ! element 57 (3D 20node 8ip) - 10 & ! element 21 (3D 20node 27ip) - ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type - int([ & - 1, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 4, & ! element 136 (3D 6node 6ip) - 4, & ! element 117 (3D 8node 1ip) - 4, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_dimension = & !< dimension of geometry type - int([ & - 2, & ! element 6 (2D 3node 1ip) - 2, & ! element 125 (2D 6node 3ip) - 2, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 3, & ! element 134 (3D 4node 1ip) - 3, & ! element 127 (3D 10node 4ip) - 3, & ! element 136 (3D 6node 6ip) - 3, & ! element 117 (3D 8node 1ip) - 3, & ! element 7 (3D 8node 8ip) - 3 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element - int([ & - 3, & ! element 6 (2D 3node 1ip) - 6, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 8, & ! element 27 (2D 8node 9ip) - 8, & ! element 54 (2D 8node 4ip) - 4, & ! element 134 (3D 4node 1ip) - 5, & ! element 157 (3D 5node 4ip) - 10, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 20, & ! element 57 (3D 20node 8ip) - 20 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nfaces = & !< number of faces of a specific type of element geometry + 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) @@ -269,27 +191,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 8,7,6,5 & ],pInt),[FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes]) - integer(pInt), dimension(FE_Ngeomtypes), parameter, private :: FE_Ncellnodes = & !< number of cell nodes in a specific geometry type - int([ & - 3, & ! element 6 (2D 3node 1ip) - 7, & ! element 125 (2D 6node 3ip) - 9, & ! element 11 (2D 4node 4ip) - 16, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 15, & ! element 127 (3D 10node 4ip) - 21, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 27, & ! element 7 (3D 8node 8ip) - 64 & ! element 21 (3D 20node 27ip) - ],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([& @@ -299,21 +200,7 @@ integer(pInt), dimension(:,:), allocatable, private :: & 4 & ! (3D 8node) ],pInt) - integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_Nips = & !< number of IPs in a specific type of element - int([ & - 1, & ! element 6 (2D 3node 1ip) - 3, & ! element 125 (2D 6node 3ip) - 4, & ! element 11 (2D 4node 4ip) - 9, & ! element 27 (2D 8node 9ip) - 1, & ! element 134 (3D 4node 1ip) - 4, & ! element 127 (3D 10node 4ip) - 6, & ! element 136 (3D 6node 6ip) - 1, & ! element 117 (3D 8node 1ip) - 8, & ! element 7 (3D 8node 8ip) - 27 & ! element 21 (3D 20node 27ip) - ],pInt) - - integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + 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) @@ -322,23 +209,8 @@ integer(pInt), dimension(:,:), allocatable, private :: & ],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) - 1, & ! element 125 (2D 6node 3ip) - 1, & ! element 11 (2D 4node 4ip) - 2, & ! element 27 (2D 8node 9ip) - 4, & ! element 134 (3D 4node 1ip) - 1, & ! element 127 (3D 10node 4ip) - 1, & ! element 136 (3D 6node 6ip) - 8, & ! element 117 (3D 8node 1ip) - 1, & ! element 7 (3D 8node 8ip) - 4 & ! element 21 (3D 20node 27ip) - ],pInt) - 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 mesh_NelemSets character(len=64), dimension(:), allocatable, private :: & mesh_nameElemSet @@ -385,7 +257,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & mesh_marc_map_Elements, & mesh_marc_map_nodes, & mesh_marc_build_nodes, & - mesh_marc_count_cpSizes, & mesh_marc_build_elements type, public, extends(tMesh) :: tMesh_marc @@ -449,7 +320,8 @@ subroutine mesh_init(ip,el) integer(pInt), parameter :: FILEUNIT = 222_pInt integer(pInt) :: j, fileFormatVersion, elemType integer(pInt) :: & - mesh_maxNelemInSet + mesh_maxNelemInSet, & + mesh_NcpElems logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' @@ -491,14 +363,14 @@ subroutine mesh_init(ip,el) 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,FILEUNIT) !ToDo: don't work on global variables + 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(FILEUNIT) !ToDo: don't work on global variables + 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 + 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) @@ -535,18 +407,18 @@ subroutine mesh_init(ip,el) call mesh_build_ipNeighborhood if (myDebug) write(6,'(a)') ' Built IP neighborhood'; flush(6) - if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + 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 > mesh_NcpElems) & + 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 > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & + 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,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 + 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(mesh_maxNips,mesh_NcpElems)) + 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" @@ -785,7 +657,7 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) !-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' +!> @brief Count overall number of CP elements in mesh !-------------------------------------------------------------------------------------------------- integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileFormatVersion,fileUnit) @@ -841,7 +713,7 @@ integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileForma !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) +subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,nElems,fileUnit) use math, only: math_qsort use IO, only: IO_lc, & @@ -851,7 +723,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) IO_continuousIntValues implicit none - integer(pInt), intent(in) :: fileUnit,tableStyle + integer(pInt), intent(in) :: fileUnit,tableStyle,nElems character(len=64), intent(in), dimension(:) :: nameElemSet integer(pInt), dimension(:,:), intent(in) :: & mapElemSet @@ -860,7 +732,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) character(len=300) :: line, & tmp - integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts + integer(pInt), dimension (1_pInt+nElems) :: contInts integer(pInt) :: i,cpElem cpElem = 0_pInt @@ -874,7 +746,7 @@ subroutine mesh_marc_map_elements(tableStyle,nameElemSet,mapElemSet,fileUnit) 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,mesh_NcpElems,nameElemSet,& + contInts = IO_continuousIntValues(fileUnit,nElems,nameElemSet,& mapElemSet,size(nameElemSet)) exit endif @@ -912,7 +784,7 @@ end subroutine mesh_marc_map_elements !-------------------------------------------------------------------------------------------------- !> @brief Maps node from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- -subroutine mesh_marc_map_nodes(fileUnit) +subroutine mesh_marc_map_nodes(nNodes,fileUnit) use math, only: math_qsort use IO, only: IO_lc, & @@ -921,12 +793,12 @@ subroutine mesh_marc_map_nodes(fileUnit) IO_fixedIntValue implicit none - integer(pInt), intent(in) :: fileUnit + integer(pInt), intent(in) :: fileUnit, nNodes integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension (mesh_Nnodes) :: node_count + integer(pInt), dimension (nNodes) :: node_count integer(pInt) :: i node_count = 0_pInt @@ -937,7 +809,7 @@ subroutine mesh_marc_map_nodes(fileUnit) 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 + 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 @@ -953,7 +825,6 @@ 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) @@ -1017,10 +888,6 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) 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 t = -1_pInt rewind(fileUnit) @@ -1037,13 +904,7 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) if (t == -1_pInt) t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message mesh_marc_count_cpSizes = t - 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 + !call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line !ToDo: this is dangerous in case of a non-CP element, everything is mixed up endif enddo exit @@ -1074,10 +935,10 @@ subroutine mesh_marc_build_elements(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line - integer(pInt), dimension(1_pInt+mesh_NcpElems) :: contInts + integer(pInt), dimension(1_pInt+theMesh%nElems) :: contInts integer(pInt) :: i,j,t,sv,myVal,e,nNodesAlreadyRead - allocate(mesh_element(4_pInt+mesh_maxNnodes,mesh_NcpElems), source=0_pInt) + allocate(mesh_element(4_pInt+theMesh%elem%nNodes,theMesh%nElems), source=0_pInt) mesh_elemType = -1_pInt @@ -1103,7 +964,7 @@ subroutine mesh_marc_build_elements(fileUnit) 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 + 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) @@ -1138,7 +999,7 @@ subroutine mesh_marc_build_elements(fileUnit) read (fileUnit,'(A300)',END=630) line ! read extra line endif contInts = IO_continuousIntValues& ! get affected elements - (fileUnit,mesh_NcpElems,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) + (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 @@ -1320,23 +1181,23 @@ subroutine mesh_build_ipVolumes integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume - allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + 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,mesh_NcpElems ! loop over cpElems + do e = 1_pInt,theMesh%nElems ! loop over cpElems t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + g = theMesh%elem%geomType + c = theMesh%elem%cellType select case (c) case (1_pInt) ! 2D 3node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + 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:FE_Nips(g)) & ! loop over ips=cells in this element + 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))) & @@ -1345,7 +1206,7 @@ subroutine mesh_build_ipVolumes mesh_cellnode(1:3,mesh_cell(1,i,e))) case (3_pInt) ! 3D 4node - forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element + 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)), & @@ -1353,7 +1214,7 @@ subroutine mesh_build_ipVolumes case (4_pInt) ! 3D 8node m = FE_NcellnodesPerCellface(c) - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + 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(& @@ -1390,19 +1251,19 @@ subroutine mesh_build_ipCoordinates real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & - allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + 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,mesh_NcpElems ! loop over cpElems + do e = 1_pInt,theMesh%nElems ! loop over cpElems t = mesh_element(2_pInt,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=cells in this element + g = theMesh%elem%geomType + c = theMesh%elem%cellType + do i = 1_pInt,theMesh%elem%nIPs myCoords = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + 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(FE_NcellnodesPerCell(c),pReal) + mesh_ipCoordinates(1:3,i,e) = myCoords / real(theMesh%elem%nCellnodesPerCell,pReal) enddo enddo !$OMP END PARALLEL DO @@ -1422,13 +1283,13 @@ pure function mesh_cellCenterCoordinates(ip,el) integer(pInt) :: t,g,c,n t = mesh_element(2_pInt,el) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell type + g = theMesh%elem%geomType + c = theMesh%elem%cellType mesh_cellCenterCoordinates = 0.0_pReal - do n = 1_pInt,FE_NcellnodesPerCell(c) ! loop over cell nodes in this cell + 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(FE_NcellnodesPerCell(c),pReal) + mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real(theMesh%elem%nCellnodesPerCell,pReal) end function mesh_cellCenterCoordinates @@ -1448,18 +1309,18 @@ subroutine mesh_build_ipAreas real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals real(pReal), dimension(3) :: normal - allocate(mesh_ipArea(mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) - allocate(mesh_ipAreaNormal(3_pInt,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems), source=0.0_pReal) + 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,mesh_NcpElems ! loop over cpElems + do e = 1_pInt,theMesh%nElems ! loop over cpElems t = mesh_element(2_pInt,e) ! get element type - g = FE_geomtype(t) ! get geometry type - c = FE_celltype(g) ! get cell 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,FE_Nips(g) ! loop over ips=cells in this element + 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)) @@ -1472,7 +1333,7 @@ subroutine mesh_build_ipAreas enddo case (3_pInt) ! 3D 4node - do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element + 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)) @@ -1489,7 +1350,7 @@ subroutine mesh_build_ipAreas ! 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,FE_Nips(g) ! loop over ips=cells in this element + 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)) @@ -1600,8 +1461,8 @@ subroutine mesh_build_sharedElems node_count = 0_pInt - do e = 1_pInt,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + 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) @@ -1621,8 +1482,8 @@ subroutine mesh_build_sharedElems allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes),source=0_pInt) - do e = 1_pInt,mesh_NcpElems - g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType + 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) @@ -1675,16 +1536,16 @@ subroutine mesh_build_ipNeighborhood matchingNodes logical checkTwins - allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) + allocate(mesh_ipNeighborhood(3,theMesh%elem%nIPneighbors,theMesh%elem%nIPs,theMesh%nElems)) mesh_ipNeighborhood = 0_pInt - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems - myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem + 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(FE_celltype(myType)) ! loop over neighbors of IP - neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) + 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 @@ -1701,11 +1562,11 @@ subroutine mesh_build_ipNeighborhood 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 = FE_geomtype(mesh_element(2,matchingElem)) + neighboringType = theMesh%elem%geomType !*** trivial solution if neighbor has only one IP - if (FE_Nips(neighboringType) == 1_pInt) then + if (theMesh%elem%nIPs == 1_pInt) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt cycle @@ -1715,8 +1576,8 @@ subroutine mesh_build_ipNeighborhood NlinkedNodes = 0_pInt linkedNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face - anchor = FE_nodesAtIP(a,myIP,myType) + 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 @@ -1733,11 +1594,11 @@ subroutine mesh_build_ipNeighborhood !*** and try to find an ip with matching nodes !*** also try to match with node twins - checkCandidateIP: do candidateIP = 1_pInt,FE_Nips(neighboringType) + checkCandidateIP: do candidateIP = 1_pInt,theMesh%elem%nIPs NmatchingNodes = 0_pInt matchingNodes = 0_pInt - do a = 1_pInt,FE_maxNnodesAtIP(neighboringType) ! check each anchor node of that ip - anchor = FE_nodesAtIP(a,candidateIP,neighboringType) + 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 @@ -1787,15 +1648,15 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems - myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType - do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem - do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP + 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 = FE_geomtype(mesh_element(2,neighboringElem)) - do pointingToMe = 1_pInt,FE_NipNeighbors(FE_celltype(neighboringType)) ! find neighboring index that points from my neighbor to myself + 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),& @@ -1822,7 +1683,7 @@ integer(pInt), intent(out) :: matchingElem, & matchingFace ! matching face ID integer(pInt), intent(in) :: face, & ! face ID elem ! CP elem ID -integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & +integer(pInt), dimension(FE_NmatchingNodesPerFace(face,theMesh%elem%geomType)) :: & myFaceNodes ! global node ids on my face integer(pInt) :: myType, & candidateType, & @@ -1841,7 +1702,7 @@ logical checkTwins matchingElem = 0_pInt matchingFace = 0_pInt minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case -myType = FE_geomtype(mesh_element(2_pInt,elem)) ! figure elemGeomType +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 @@ -1859,7 +1720,7 @@ checkCandidate: do i = 1_pInt,minNsharedElems 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 = FE_geomtype(mesh_element(2_pInt,candidateElem)) ! figure elemGeomType of candidate + 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 @@ -1949,678 +1810,14 @@ end function FE_mapElemtype !-------------------------------------------------------------------------------------------------- !> @brief get properties of different types of finite elements -!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace +!> @details assign globals FE_cellface !-------------------------------------------------------------------------------------------------- subroutine mesh_build_FEdata implicit none integer(pInt) :: me - allocate(FE_nodesAtIP(FE_maxmaxNnodesAtIP,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_ipNeighbor(FE_maxNipNeighbors,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cell(FE_maxNcellnodesPerCell,FE_maxNips,FE_Ngeomtypes), source=0_pInt) - allocate(FE_cellnodeParentnodeWeights(FE_maxNnodes,FE_maxNcellnodes,FE_Nelemtypes), source=0.0_pReal) allocate(FE_cellface(FE_maxNcellnodesPerCellface,FE_maxNcellfaces,FE_Ncelltypes), source=0_pInt) - - !*** fill FE_nodesAtIP with data *** - - me = 0_pInt - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - 1,2,3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, & - 2, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, & - 2, & - 4, & - 3 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - reshape(int([& - 1,0, & - 1,2, & - 2,0, & - 1,4, & - 0,0, & - 2,3, & - 4,0, & - 3,4, & - 3,0 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - 1,2,3,4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - reshape(int([& - 1, & - 2, & - 3, & - 4 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - reshape(int([& - 1, & - 2, & - 3, & - 4, & - 5, & - 6 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - 1,2,3,4,5,6,7,8 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - reshape(int([& - 1, & - 2, & - 4, & - 3, & - 5, & - 6, & - 8, & - 7 & - ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - me = me + 1_pInt - FE_nodesAtIP(1:FE_maxNnodesAtIP(me),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - 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),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - - - ! *** 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. - me = 0_pInt - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - -2,-3,-1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 2,-3, 3,-1, & - -2, 1, 3,-1, & - 2,-3,-2, 1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 2,-4, 3,-1, & - -2, 1, 4,-1, & - 4,-4,-3, 1, & - -2, 3,-3, 2 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - -1,-2,-3,-4 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - -3,-5,-4,-2,-6,-1 & - ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - 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),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cell *** - me = 0_pInt - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 6 (2D 3node 1ip) - reshape(int([& - 1,2,3 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) - reshape(int([& - 1, 4, 7, 6, & - 2, 5, 7, 4, & - 3, 6, 7, 5 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) - reshape(int([& - 1, 5, 9, 8, & - 5, 2, 6, 9, & - 8, 9, 7, 4, & - 9, 6, 3, 7 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 27 (2D 8node 9ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 134 (3D 4node 1ip) - reshape(int([& - 1, 2, 3, 4 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 127 (3D 10node 4ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 136 (3D 6node 6ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 117 (3D 8node 1ip) - reshape(int([& - 1, 2, 3, 4, 5, 6, 7, 8 & - ],pInt),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 7 (3D 8node 8ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - me = me + 1_pInt - FE_cell(1:FE_NcellnodesPerCell(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 21 (3D 20node 27ip) - 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),[FE_NcellnodesPerCell(FE_celltype(me)),FE_Nips(me)]) - - - ! *** FE_cellnodeParentnodeWeights *** - ! center of gravity of the weighted nodes gives the position of the cell node. - ! fill with 0. - ! 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 - me = 0_pInt - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) - reshape(real([& - 1, 0, 0, & - 0, 1, 0, & - 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 27 (2D 8node 9ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 54 (2D 8node 4ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) - reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & - 0, 0, 1, 0, & - 0, 0, 0, 1 & - ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 127 (3D 10node 4ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 136 (3D 6node 6ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) - 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),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - - - ! *** FE_cellface *** me = 0_pInt From a57aa7985a9d9847b6fa84d61651b492e80a397b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sun, 3 Feb 2019 18:11:16 +0100 Subject: [PATCH 62/92] wrong name --- src/mesh_abaqus.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 89f0eed06..60b1484c1 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -490,7 +490,7 @@ 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) - call mesh_get_damaskOptions(mesh_periodic_surface,FILEUNIT) + call mesh_get_damaskOptions(mesh_periodicSurface,FILEUNIT) if (myDebug) write(6,'(a)') ' Got DAMASK options'; flush(6) close (FILEUNIT) From 3f61c97dedeefd00fe8d508f7bccf36027dd65f1 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Feb 2019 18:49:30 +0100 Subject: [PATCH 63/92] don't support non-DAMASK materials --- src/mesh_marc.f90 | 70 ++++++----------------------------------------- 1 file changed, 9 insertions(+), 61 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index a269b60e4..c793dc7eb 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -253,7 +253,6 @@ integer(pInt), dimension(:,:), allocatable, private :: & 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, & @@ -359,7 +358,7 @@ subroutine mesh_init(ip,el) call mesh_marc_map_elementSets(mesh_nameElemSet,mesh_mapElemSet,FILEUNIT) if (myDebug) write(6,'(a)') ' Mapped element sets'; flush(6) - mesh_NcpElems = mesh_marc_count_cpElements(hypoelasticTableStyle,Marc_matNumber,fileFormatVersion,FILEUNIT) + mesh_NcpElems = mesh_nElems if (myDebug) write(6,'(a)') ' Counted CP elements'; flush(6) allocate (mesh_mapFEtoCPelem(2,mesh_NcpElems), source = 0_pInt) @@ -656,60 +655,6 @@ subroutine mesh_marc_map_elementSets(nameElemSet,mapElemSet,fileUnit) 640 end subroutine mesh_marc_map_elementSets -!-------------------------------------------------------------------------------------------------- -!> @brief Count overall number of CP elements in mesh -!-------------------------------------------------------------------------------------------------- -integer(pInt) function mesh_marc_count_cpElements(tableStyle,matNumber,fileFormatVersion,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, tableStyle,fileFormatVersion - integer(pInt), dimension(:), intent(in) :: matNumber - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i - character(len=300):: line - - mesh_marc_count_cpElements = 0_pInt - - - rewind(fileUnit) - if (fileFormatVersion < 13) then ! Marc 2016 or earlier - do - read (fileUnit,'(A300)',END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+tableStyle ! Skip 3 or 4 lines - read (fileUnit,'(A300)') line - enddo - mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countContinuousIntValues(fileUnit) - exit - endif - enddo - else ! Marc2017 and later - 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)') line - chunkPos = IO_stringPos(line) - if (any(matNumber==IO_intValue(line,chunkPos,6_pInt))) then - mesh_marc_count_cpElements = mesh_marc_count_cpElements + IO_countNumericalDataLines(fileUnit) - endif - endif - enddo - end if - -620 end function mesh_marc_count_cpElements - - !-------------------------------------------------------------------------------------------------- !> @brief Maps elements from FE ID to internal (consecutive) representation. !-------------------------------------------------------------------------------------------------- @@ -880,10 +825,12 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) 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 @@ -899,13 +846,14 @@ integer(pInt) function mesh_marc_count_cpSizes(fileUnit) do i=1_pInt,mesh_Nelems ! read all elements read (fileUnit,'(A300)') 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 - if (t == -1_pInt) t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) - if (t /= FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt))) call IO_error(0_pInt) !ToDo: error message + if (t == -1_pInt) then + t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) + call tempEl%init(t) mesh_marc_count_cpSizes = t - !call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line !ToDo: this is dangerous in case of a non-CP element, everything is mixed up + 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 From 542ab946cc7db07e83d00f5d1097db1f62cd3fd7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Mon, 4 Feb 2019 19:05:02 +0100 Subject: [PATCH 64/92] [skip ci] not needed --- src/mesh_marc.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index c793dc7eb..0e0336f99 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -53,8 +53,6 @@ module mesh logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) - integer(pInt), private :: & - mesh_Nmaterials integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID From 889cfc8ba039559f028b24dfeb4b102e33aa1c37 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 01:39:54 +0100 Subject: [PATCH 65/92] vtk script only work with python3 on new testing --- processing/post/vtk_addGridData.py | 2 +- processing/post/vtk_addPointcloudData.py | 2 +- processing/post/vtk_addRectilinearGridData.py | 2 +- processing/post/vtk_pointcloud.py | 2 +- processing/post/vtk_rectilinearGrid.py | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) 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 From c36e6cbbf6b9e630fb70b67b7970fb16b5e2c363 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 00:10:24 +0000 Subject: [PATCH 66/92] current software version --- .gitlab-ci.yml | 36 +++++++++++++++++------------------- 1 file changed, 17 insertions(+), 19 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f1af6259f..d80e91654 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -9,7 +9,7 @@ stages: - spectral - compileMarc2018_1 - marc - - compileAbaqus2017 + - compileAbaqus2019 - example - performance - createPackage @@ -51,34 +51,32 @@ 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" + 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" From 535639d933b79418353747aa02a11d4ded7ac828 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 19:08:56 +0000 Subject: [PATCH 67/92] new doxygen --- .gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index d80e91654..62e243505 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -79,9 +79,9 @@ variables: 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" ################################################################################################### From 415b668e829e036b098d3286cc8859244a489828 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 19:12:31 +0000 Subject: [PATCH 68/92] tests for new server --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index beb9682ff..4909d74e0 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b +Subproject commit 4909d74e08f8f0065e2ad71ab35030e2e104d403 From dd491027486403e6a9eebed6cb41dc7b0e49cdc4 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 20:37:39 +0100 Subject: [PATCH 69/92] missing update of stages --- .gitlab-ci.yml | 12 ++++++------ PRIVATE | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 62e243505..1f5536445 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -7,9 +7,9 @@ stages: - compilePETScGNU - prepareSpectral - spectral - - compileMarc2018_1 + - compileMarc - marc - - compileAbaqus2019 + - compileAbaqus - example - performance - createPackage @@ -381,9 +381,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 @@ -429,9 +429,9 @@ J2_plasticBehavior: ################################################################################################### Abaqus_compile2017: - stage: compileAbaqus2017 + stage: compileAbaqus script: - - module load $IntelCompiler16_4 $Abaqus2017 + - module load $IntelCompiler16_4 $Abaqus - Abaqus_compileIfort/test.py -a 2017 except: - master diff --git a/PRIVATE b/PRIVATE index 4909d74e0..406d482f8 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 4909d74e08f8f0065e2ad71ab35030e2e104d403 +Subproject commit 406d482f8059b4459634af729ce85491a9a3245c From 2cda3cd0f9bd325d265111e442dc183e803824ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 20:41:37 +0100 Subject: [PATCH 70/92] only test for most recent version anyway --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 1f5536445..621db50ae 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -431,7 +431,7 @@ J2_plasticBehavior: Abaqus_compile2017: stage: compileAbaqus script: - - module load $IntelCompiler16_4 $Abaqus + - module load $IntelAbaqus $Abaqus - Abaqus_compileIfort/test.py -a 2017 except: - master From 6988047df46c8d76b83189203e3260c2aaac463a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 21:22:12 +0100 Subject: [PATCH 71/92] added repository --- README | 1 + 1 file changed, 1 insertion(+) 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 From 6abc8e7ebf7f62751ad486370dbbb53ecdc15d4e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 21:53:20 +0100 Subject: [PATCH 72/92] Abaqus 2019 is out --- CONFIG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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 From c4cb35891cccbed2f2d51f60e5253a8c12ea2757 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 22:56:39 +0100 Subject: [PATCH 73/92] all fine with python3 --- processing/post/addCumulative.py | 2 +- processing/post/addDerivative.py | 2 +- processing/post/blowUp.py | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) 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/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 From 1adffb0debf3e60277d26d334a0df9432bc4674a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 23:04:28 +0100 Subject: [PATCH 74/92] tests for python3 compatible scripts --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 406d482f8..c6db7cee2 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 406d482f8059b4459634af729ce85491a9a3245c +Subproject commit c6db7cee2d9349e2d463f5ef6284446007fc7915 From 68ebb121eabd08c3afd07e9203be94d8a941c631 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 14 Feb 2019 23:32:30 +0100 Subject: [PATCH 75/92] python3 test --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index c6db7cee2..999c63092 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c6db7cee2d9349e2d463f5ef6284446007fc7915 +Subproject commit 999c63092647de5e951382ba15d64b1a3f1e89be From 742d58cfcedfa3029ec1c2cc0e36f694ebf496e5 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 14 Feb 2019 18:24:09 -0500 Subject: [PATCH 76/92] added ASCIItable tests to CI pipelining --- .gitlab-ci.yml | 7 ++++ PRIVATE | 2 +- processing/post/addLinked.py | 6 +-- processing/post/addTable.py | 2 +- processing/pre/geom_grainGrowth.py | 47 ++++++++++++------------ processing/pre/seeds_fromDistribution.py | 17 +++++---- 6 files changed, 45 insertions(+), 36 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 621db50ae..e883ac986 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -156,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 diff --git a/PRIVATE b/PRIVATE index c6db7cee2..3d12562fb 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit c6db7cee2d9349e2d463f5ef6284446007fc7915 +Subproject commit 3d12562fbfb3a57dbb3777ac045a12376b3400e8 diff --git a/processing/post/addLinked.py b/processing/post/addLinked.py index d60307bc2..e0569324b 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,7 @@ 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/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/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() From dc133344b65537d97372c38a9d493d363e81a169 Mon Sep 17 00:00:00 2001 From: Philip Eisenlohr Date: Thu, 14 Feb 2019 18:43:34 -0500 Subject: [PATCH 77/92] [skip ci] migrated to python3 compatibility --- processing/pre/geom_toTable.py | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) 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 = [] From 5ef219cdb9420e0b6a6797cebeca88058d727c08 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 06:05:12 +0100 Subject: [PATCH 78/92] module name was renamed --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index e883ac986..bcb0952db 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -51,7 +51,7 @@ variables: # Names of module files to load # =============================================================================================== # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ - IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4" + 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" From 31b3cca1ad825ed4009551bbe8f63e46acb8fc7c Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 06:42:19 +0100 Subject: [PATCH 79/92] [skip ci] also python3 compatible --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 3d12562fb..3358be226 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3d12562fbfb3a57dbb3777ac045a12376b3400e8 +Subproject commit 3358be226989780b4969554e688a1bdff3d02c70 From c50078bafceec285354d88adadf817dd3f2d949a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 14:22:26 +0100 Subject: [PATCH 80/92] short version not needed any more Abaqus version is year --- python/damask/solver/abaqus.py | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index bf8691533..6826ad24b 100644 --- a/python/damask/solver/abaqus.py +++ b/python/damask/solver/abaqus.py @@ -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] 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()) From 8b829410142d6f0f50e67dce25cac5d9ba0bdc6a Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 14:23:16 +0100 Subject: [PATCH 81/92] only Abaqus 2019 is available --- .gitlab-ci.yml | 4 ++-- python/damask/solver/abaqus.py | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index bcb0952db..25616cc99 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -435,11 +435,11 @@ J2_plasticBehavior: - release ################################################################################################### -Abaqus_compile2017: +Abaqus_compile: stage: compileAbaqus script: - module load $IntelAbaqus $Abaqus - - Abaqus_compileIfort/test.py -a 2017 + - Abaqus_compileIfort/test.py except: - master - release diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index 6826ad24b..305e5cbe1 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): From 88fc37d8a7c723cf529e30cdbda406734ba7db43 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 16:22:52 +0100 Subject: [PATCH 82/92] some more work on python3 compatible scripts --- PRIVATE | 2 +- python/damask/solver/abaqus.py | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/PRIVATE b/PRIVATE index 3358be226..5d43a56aa 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 3358be226989780b4969554e688a1bdff3d02c70 +Subproject commit 5d43a56aa25e90462660056a45648caedd99dac6 diff --git a/python/damask/solver/abaqus.py b/python/damask/solver/abaqus.py index 305e5cbe1..22dbab045 100644 --- a/python/damask/solver/abaqus.py +++ b/python/damask/solver/abaqus.py @@ -21,7 +21,7 @@ class Abaqus(Solver): 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 {}, but requested {}'.format(detectedVersion,self.version)) return '{} -job {} -user {}/src/DAMASK_abaqus interactive'.format(cmd,model,env.rootDir()) From d53d1224b8d56bf5b5c6e5b006a6d08d2b84919e Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 19:01:11 +0100 Subject: [PATCH 83/92] python3 compatible test --- PRIVATE | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/PRIVATE b/PRIVATE index 5d43a56aa..18ba1ba6a 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 5d43a56aa25e90462660056a45648caedd99dac6 +Subproject commit 18ba1ba6a5e9ba446dc9311acf2acf2781614db1 From afdaac47af4f4675a594cd219b354c61aa82bca9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Fri, 15 Feb 2019 22:54:38 +0100 Subject: [PATCH 84/92] avoid disturbing reporting --- src/DAMASK_abaqus.f | 29 ++++++++++++++++++---------- src/DAMASK_interface.f90 | 41 ++++++++++++++++++++++++++-------------- src/DAMASK_marc.f90 | 31 +++++++++++++++++++----------- src/compilation_info.f90 | 14 -------------- 4 files changed, 66 insertions(+), 49 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index 9072de95d..f17b5bb25 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -40,16 +40,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..845441e57 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -53,17 +53,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) 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) From 0fd547688301fda63597f402c45a225af7e89fd5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 06:42:08 +0100 Subject: [PATCH 85/92] doxygen interprets comment as doc string --- src/kinematics_thermal_expansion.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) 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, & From 73235ab64a296164e8faaa17191fd65dc8efe2b4 Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 16 Feb 2019 08:16:37 +0000 Subject: [PATCH 86/92] [skip ci] updated version information after successful test of v2.0.2-1713-g0fd54768 --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index 6e1ce244f..c778e617c 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1689-g1a471bcd +v2.0.2-1713-g0fd54768 From 9a3921ea84c16d2516ea4aaf10b13ea0416222cd Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 10:20:53 +0100 Subject: [PATCH 87/92] ifdef statements grouped together unless they belong to a group of functions, like opening files or interpreting lines --- src/IO.f90 | 103 ++++++++++++++++++++++++----------------------------- 1 file changed, 47 insertions(+), 56 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index b5868fa48..04b32d396 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -68,20 +68,14 @@ 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 @@ -816,52 +810,6 @@ pure function IO_lc(string) end function IO_lc -#ifdef Marc4DAMASK -!-------------------------------------------------------------------------------------------------- -!> @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 - - -#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 -# endif - !-------------------------------------------------------------------------------------------------- !> @brief returns format string for integer values without leading zeros !-------------------------------------------------------------------------------------------------- @@ -1251,7 +1199,30 @@ 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 !-------------------------------------------------------------------------------------------------- @@ -1316,10 +1287,31 @@ integer(pInt) function IO_countNumericalDataLines(fileUnit) 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 -#if defined(Abaqus) || defined(Marc4DAMASK) !-------------------------------------------------------------------------------------------------- !> @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 @@ -1490,7 +1482,6 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) 100 end function IO_continuousIntValues #endif - !-------------------------------------------------------------------------------------------------- ! internal helper functions From 61032b5fd8d2a7fc2ada7ef89b5d5648acdce4f5 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 10:24:12 +0100 Subject: [PATCH 88/92] wrong jump position probably a copy and paste error --- src/mesh_marc.f90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index 0e0336f99..f9ba0378b 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -926,17 +926,17 @@ subroutine mesh_marc_build_elements(fileUnit) enddo 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" - read (fileUnit,'(A300)',END=620) line - do !ToDo: the jumps to 620 in below code might result in a never ending loop + 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=620) line ! read extra line for new style + 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=620) line ! read line with value of state var + 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 @@ -950,7 +950,7 @@ subroutine mesh_marc_build_elements(fileUnit) e = mesh_FEasCP('elem',contInts(1_pInt+i)) mesh_element(1_pInt+sv,e) = myVal enddo - if (initialcondTableStyle == 0_pInt) read (fileUnit,'(A300)',END=620) line ! ignore IP range for old table style + 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 From efe9823e620ddc92fbd48f07f7843ab8b3cccca3 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 10:43:02 +0100 Subject: [PATCH 89/92] clearer logic for preprocessor statements --- src/IO.f90 | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 04b32d396..42ba479cd 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -45,20 +45,19 @@ module IO IO_timeStamp #if defined(Marc4DAMASK) || defined(Abaqus) public :: & -#ifdef Abaqus - IO_extractValue, & - IO_countDataLines, & -#endif -#ifdef Marc4DAMASK - IO_skipChunks, & - IO_fixedNoEFloatValue, & - IO_fixedIntValue, & - IO_countNumericalDataLines, & -#endif IO_open_inputFile, & IO_open_logFile, & IO_countContinuousIntValues, & - IO_continuousIntValues + IO_continuousIntValues, & +#if defined(Abaqus) + IO_extractValue, & + IO_countDataLines +#elif defined(Marc4DAMASK) + IO_skipChunks, & + IO_fixedNoEFloatValue, & + IO_fixedIntValue, & + IO_countNumericalDataLines +#endif #endif private :: & IO_verifyFloatValue, & @@ -356,7 +355,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 @@ -427,8 +426,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) 200 createSuccess =.false. end function abaqus_assembleInputFile -#endif -#ifdef Marc4DAMASK +#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) From 77d60be1279299c3f5d113be7eef31b30c325646 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 11:30:56 +0100 Subject: [PATCH 90/92] avoid superfluous reporting --- src/DAMASK_abaqus.f | 5 +++++ src/DAMASK_marc.f90 | 5 +++++ src/mesh_abaqus.f90 | 8 -------- src/mesh_grid.f90 | 8 -------- src/mesh_marc.f90 | 9 --------- 5 files changed, 10 insertions(+), 25 deletions(-) diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index f17b5bb25..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 diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 9b1427d78..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 diff --git a/src/mesh_abaqus.f90 b/src/mesh_abaqus.f90 index 60b1484c1..4e923606e 100644 --- a/src/mesh_abaqus.f90 +++ b/src/mesh_abaqus.f90 @@ -6,7 +6,6 @@ !> @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 @@ -425,11 +424,6 @@ end subroutine tMesh_abaqus_init !! 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 use DAMASK_interface use IO, only: & IO_open_InputFile, & @@ -458,8 +452,6 @@ subroutine mesh_init(ip,el) logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh diff --git a/src/mesh_grid.f90 b/src/mesh_grid.f90 index d55c1cded..424456e3a 100644 --- a/src/mesh_grid.f90 +++ b/src/mesh_grid.f90 @@ -169,11 +169,6 @@ end subroutine tMesh_grid_init !! 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 #include use PETScsys @@ -206,9 +201,6 @@ subroutine mesh_init(ip,el) logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh diff --git a/src/mesh_marc.f90 b/src/mesh_marc.f90 index f9ba0378b..0c7d332c9 100644 --- a/src/mesh_marc.f90 +++ b/src/mesh_marc.f90 @@ -6,7 +6,6 @@ !> @brief Sets up the mesh for the solver MSC.Marc !-------------------------------------------------------------------------------------------------- module mesh - use, intrinsic :: iso_c_binding use prec, only: pReal, pInt use mesh_base @@ -284,11 +283,6 @@ end subroutine tMesh_marc_init !! 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 use DAMASK_interface use IO, only: & IO_open_InputFile, & @@ -322,9 +316,6 @@ subroutine mesh_init(ip,el) logical :: myDebug write(6,'(/,a)') ' <<<+- mesh init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh From 63e2ea7d8f5eac38ae3ac095c8cb5eb9ed201dbe Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 16 Feb 2019 12:49:28 +0100 Subject: [PATCH 91/92] was not use (anymore) --- src/IO.f90 | 25 ------------------------- 1 file changed, 25 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index 42ba479cd..3d330a2df 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -27,7 +27,6 @@ module IO IO_open_file_stat, & IO_open_jobFile_stat, & IO_open_file, & - IO_open_jobFile, & IO_write_jobFile, & IO_write_jobRealFile, & IO_read_realFile, & @@ -291,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 From e1525cc529aa1ed0b09ec1d2b5842499c4be724f Mon Sep 17 00:00:00 2001 From: Test User Date: Sat, 16 Feb 2019 16:58:23 +0000 Subject: [PATCH 92/92] [skip ci] updated version information after successful test of v2.0.2-1789-g524bfb8c --- VERSION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/VERSION b/VERSION index c778e617c..e1be2bda8 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-1713-g0fd54768 +v2.0.2-1789-g524bfb8c