2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2013-04-18 22:10:49 +05:30
!> @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
2018-01-10 21:43:25 +05:30
!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2014-04-29 23:20:59 +05:30
module mesh
2012-08-27 13:34:47 +05:30
use , intrinsic :: iso_c_binding
2012-03-09 01:55:28 +05:30
use prec , only : pReal , pInt
2019-01-24 19:49:17 +05:30
use mesh_base
2012-08-06 18:13:05 +05:30
2007-03-21 21:48:33 +05:30
implicit none
2012-03-09 01:55:28 +05:30
private
2013-01-16 16:10:53 +05:30
integer ( pInt ) , public , protected :: &
2015-03-25 21:36:19 +05:30
mesh_NcpElems , & !< total number of CP elements in local mesh
2018-09-24 00:23:35 +05:30
mesh_elemType , & !< Element type of the mesh (only support homogeneous meshes)
2012-06-15 21:40:21 +05:30
mesh_Nnodes , & !< total number of nodes in mesh
2013-04-15 13:43:20 +05:30
mesh_Ncellnodes , & !< total number of cell nodes in mesh (including duplicates)
2013-04-18 22:10:49 +05:30
mesh_Ncells , & !< total number of cells in mesh
2018-09-23 21:07:57 +05:30
mesh_NipsPerElem , & !< number of IPs in per element
mesh_NcellnodesPerElem , & !< number of cell nodes per element
2012-06-15 21:40:21 +05:30
mesh_maxNipNeighbors , & !< max number of IP neighbors in any CP element
2018-09-23 21:07:57 +05:30
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
2018-09-23 20:35:01 +05:30
mesh_maxNcellnodes !< max number of cell nodes in any CP element
2018-09-23 21:07:57 +05:30
!!!! BEGIN DEPRECATED !!!!!
2012-03-09 01:55:28 +05:30
2018-09-23 22:20:54 +05:30
integer ( pInt ) , dimension ( : ) , allocatable , public , protected :: &
2018-10-04 09:33:48 +05:30
mesh_homogenizationAt , & !< homogenization ID of each element
mesh_microstructureAt !< microstructure ID of each element
2018-09-23 22:20:54 +05:30
2013-01-16 16:10:53 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , public , protected :: &
2018-10-04 09:33:48 +05:30
mesh_CPnodeID , & !< nodes forming an element
2018-09-23 23:28:43 +05:30
mesh_element , & !DEPRECATED
2012-06-15 21:40:21 +05:30
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)
2018-01-10 21:43:25 +05:30
2013-01-16 16:10:53 +05:30
integer ( pInt ) , dimension ( : , : , : , : ) , allocatable , public , protected :: &
2012-10-24 19:33:02 +05:30
mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me]
2012-03-09 01:55:28 +05:30
2013-05-07 18:36:29 +05:30
real ( pReal ) , public , protected :: &
mesh_unitlength !< physical length of one unit in mesh
2012-03-09 01:55:28 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable , public :: &
2013-04-22 00:18:59 +05:30
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!!!)
2018-01-10 21:43:25 +05:30
2013-01-16 16:10:53 +05:30
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 :: &
2013-01-31 21:58:08 +05:30
mesh_ipArea !< area of interface to neighboring IP (initially!)
2018-01-10 21:43:25 +05:30
2013-01-16 16:10:53 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable , public :: &
mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!)
2018-01-10 21:43:25 +05:30
real ( pReal ) , dimension ( : , : , : , : ) , allocatable , public , protected :: &
2012-06-15 21:40:21 +05:30
mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!)
2018-01-10 21:43:25 +05:30
2013-01-16 16:10:53 +05:30
logical , dimension ( 3 ) , public , protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes)
2013-02-28 02:11:14 +05:30
2012-03-09 01:55:28 +05:30
integer ( pInt ) , dimension ( 2 ) , private :: &
mesh_maxValStateVar = 0_pInt
2018-01-10 21:43:25 +05:30
2018-09-23 18:57:51 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , private :: &
2013-12-28 01:33:28 +05:30
mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID
2013-04-15 13:43:20 +05:30
integer ( pInt ) , dimension ( : , : , : ) , allocatable , private :: &
2013-04-22 00:18:59 +05:30
mesh_cell !< cell connectivity for each element,ip/cell
2013-04-15 13:43:20 +05:30
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
2018-01-10 21:43:25 +05:30
2013-04-15 13:43:20 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable , private :: &
FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes
2018-01-10 21:43:25 +05:30
2013-04-15 13:43:20 +05:30
integer ( pInt ) , dimension ( : , : , : , : ) , allocatable , private :: &
FE_subNodeOnIPFace
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS)
2007-03-22 20:18:58 +05:30
! Hence, I suggest to prefix with "FE_"
2012-03-09 01:55:28 +05:30
integer ( pInt ) , parameter , public :: &
2013-04-15 13:43:20 +05:30
FE_Nelemtypes = 13_pInt , &
FE_Ngeomtypes = 10_pInt , &
FE_Ncelltypes = 4_pInt , &
FE_maxNnodes = 20_pInt , &
FE_maxNips = 27_pInt , &
FE_maxNipNeighbors = 6_pInt , &
2012-06-15 21:40:21 +05:30
FE_maxmaxNnodesAtIP = 8_pInt , & !< max number of (equivalent) nodes attached to an IP
2013-04-15 13:43:20 +05:30
FE_maxNmatchingNodesPerFace = 4_pInt , &
FE_maxNfaces = 6_pInt , &
FE_maxNcellnodes = 64_pInt , &
FE_maxNcellnodesPerCell = 8_pInt , &
FE_maxNcellfaces = 6_pInt , &
FE_maxNcellnodesPerCellface = 4_pInt
2018-01-10 21:43:25 +05:30
2012-11-16 04:15:20 +05:30
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)
2013-04-10 15:08:40 +05:30
3 , & ! element 54 (2D 8node 4ip)
2012-11-16 04:15:20 +05:30
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)
2012-02-16 00:28:38 +05:30
] , pInt )
2012-11-16 04:15:20 +05:30
2013-04-15 13:43:20 +05:30
integer ( pInt ) , dimension ( FE_Ngeomtypes ) , parameter , public :: FE_celltype = & !< cell type that is used by each geometry type
2012-11-16 04:15:20 +05:30
int ( [ &
2013-04-15 13:43:20 +05:30
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)
2012-02-16 00:28:38 +05:30
] , pInt )
2012-11-16 04:15:20 +05:30
2013-04-15 13:43:20 +05:30
integer ( pInt ) , dimension ( FE_Ngeomtypes ) , parameter , public :: FE_dimension = & !< dimension of geometry type
2013-02-05 18:57:37 +05:30
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 )
2013-04-15 13:43:20 +05:30
integer ( pInt ) , dimension ( FE_Nelemtypes ) , parameter , public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element
2012-11-16 04:15:20 +05:30
int ( [ &
3 , & ! element 6 (2D 3node 1ip)
2013-04-15 13:43:20 +05:30
6 , & ! element 125 (2D 6node 3ip)
2012-11-16 04:15:20 +05:30
4 , & ! element 11 (2D 4node 4ip)
2013-04-15 13:43:20 +05:30
8 , & ! element 27 (2D 8node 9ip)
8 , & ! element 54 (2D 8node 4ip)
2012-11-16 04:15:20 +05:30
4 , & ! element 134 (3D 4node 1ip)
2013-04-15 13:43:20 +05:30
5 , & ! element 157 (3D 5node 4ip)
10 , & ! element 127 (3D 10node 4ip)
2012-11-16 04:15:20 +05:30
6 , & ! element 136 (3D 6node 6ip)
8 , & ! element 117 (3D 8node 1ip)
8 , & ! element 7 (3D 8node 8ip)
2013-04-15 13:43:20 +05:30
20 , & ! element 57 (3D 20node 8ip)
20 & ! element 21 (3D 20node 27ip)
2012-02-16 00:28:38 +05:30
] , pInt )
2012-11-16 04:15:20 +05:30
2013-04-15 13:43:20 +05:30
integer ( pInt ) , dimension ( FE_Ngeomtypes ) , parameter , public :: FE_Nfaces = & !< number of faces of a specific type of element geometry
2012-11-16 04:15:20 +05:30
int ( [ &
2013-04-15 13:43:20 +05:30
3 , & ! element 6 (2D 3node 1ip)
2012-11-16 04:15:20 +05:30
3 , & ! element 125 (2D 6node 3ip)
4 , & ! element 11 (2D 4node 4ip)
2013-04-15 13:43:20 +05:30
4 , & ! element 27 (2D 8node 9ip)
4 , & ! element 134 (3D 4node 1ip)
2012-11-16 04:15:20 +05:30
4 , & ! element 127 (3D 10node 4ip)
2013-04-15 13:43:20 +05:30
5 , & ! element 136 (3D 6node 6ip)
6 , & ! element 117 (3D 8node 1ip)
6 , & ! element 7 (3D 8node 8ip)
6 & ! element 21 (3D 20node 27ip)
2012-02-16 00:28:38 +05:30
] , pInt )
2012-11-16 04:15:20 +05:30
2013-04-15 13:43:20 +05:30
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
2012-11-16 04:15:20 +05:30
int ( [ &
3 , & ! element 6 (2D 3node 1ip)
2013-04-15 13:43:20 +05:30
3 , & ! element 125 (2D 6node 3ip)
2012-11-16 04:15:20 +05:30
4 , & ! element 11 (2D 4node 4ip)
4 , & ! element 27 (2D 8node 9ip)
4 , & ! element 134 (3D 4node 1ip)
2013-04-15 13:43:20 +05:30
4 , & ! element 127 (3D 10node 4ip)
2012-11-16 04:15:20 +05:30
6 , & ! element 136 (3D 6node 6ip)
2013-04-15 13:43:20 +05:30
8 , & ! element 117 (3D 8node 1ip)
8 , & ! element 7 (3D 8node 8ip)
8 & ! element 21 (3D 20node 27ip)
2012-11-16 04:15:20 +05:30
] , pInt )
2013-04-15 13:43:20 +05:30
integer ( pInt ) , dimension ( FE_maxNfaces , FE_Ngeomtypes ) , parameter , private :: &
FE_NmatchingNodesPerFace = & !< number of matching nodes per face in a specific type of element geometry
2012-11-16 04:15:20 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
2 , 2 , 2 , 0 , 0 , 0 , & ! element 6 (2D 3node 1ip)
2012-11-16 04:15:20 +05:30
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)
2018-01-10 21:43:25 +05:30
] , pInt ) , [ FE_maxNipNeighbors , FE_Ngeomtypes ] )
2012-11-16 04:15:20 +05:30
2013-04-15 13:43:20 +05:30
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
2012-02-16 00:28:38 +05:30
reshape ( int ( [ &
2012-11-16 04:15:20 +05:30
1 , 2 , 0 , 0 , & ! element 6 (2D 3node 1ip)
2 , 3 , 0 , 0 , &
3 , 1 , 0 , 0 , &
2007-04-25 13:03:24 +05:30
0 , 0 , 0 , 0 , &
2007-10-12 19:18:29 +05:30
0 , 0 , 0 , 0 , &
2012-11-16 04:15:20 +05:30
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)
2007-10-12 19:18:29 +05:30
2 , 3 , 0 , 0 , &
3 , 4 , 0 , 0 , &
4 , 1 , 0 , 0 , &
0 , 0 , 0 , 0 , &
0 , 0 , 0 , 0 , &
2012-11-16 04:15:20 +05:30
1 , 2 , 0 , 0 , & ! element 27 (2D 8node 9ip)
2009-04-02 18:30:51 +05:30
2 , 3 , 0 , 0 , &
3 , 4 , 0 , 0 , &
4 , 1 , 0 , 0 , &
2007-10-12 19:18:29 +05:30
0 , 0 , 0 , 0 , &
2008-06-17 14:41:54 +05:30
0 , 0 , 0 , 0 , &
2012-11-16 04:15:20 +05:30
1 , 2 , 3 , 0 , & ! element 134 (3D 4node 1ip)
2008-06-17 14:41:54 +05:30
1 , 4 , 2 , 0 , &
2 , 3 , 4 , 0 , &
1 , 3 , 4 , 0 , &
0 , 0 , 0 , 0 , &
0 , 0 , 0 , 0 , &
2012-11-16 04:15:20 +05:30
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)
2008-06-17 14:41:54 +05:30
1 , 4 , 5 , 2 , &
2 , 5 , 6 , 3 , &
1 , 3 , 6 , 4 , &
4 , 6 , 5 , 0 , &
2009-04-02 18:30:51 +05:30
0 , 0 , 0 , 0 , &
2012-11-16 04:15:20 +05:30
1 , 2 , 3 , 4 , & ! element 117 (3D 8node 1ip)
2009-04-02 18:30:51 +05:30
2 , 1 , 5 , 6 , &
3 , 2 , 6 , 7 , &
4 , 3 , 7 , 8 , &
4 , 1 , 5 , 8 , &
2010-05-10 20:24:59 +05:30
8 , 7 , 6 , 5 , &
2012-11-16 04:15:20 +05:30
1 , 2 , 3 , 4 , & ! element 7 (3D 8node 8ip)
2010-05-10 20:24:59 +05:30
2 , 1 , 5 , 6 , &
3 , 2 , 6 , 7 , &
4 , 3 , 7 , 8 , &
4 , 1 , 5 , 8 , &
2010-08-17 04:23:24 +05:30
8 , 7 , 6 , 5 , &
2012-11-16 04:15:20 +05:30
1 , 2 , 3 , 4 , & ! element 21 (3D 20node 27ip)
2010-08-17 04:23:24 +05:30
2 , 1 , 5 , 6 , &
3 , 2 , 6 , 7 , &
4 , 3 , 7 , 8 , &
4 , 1 , 5 , 8 , &
2012-11-16 04:15:20 +05:30
8 , 7 , 6 , 5 &
2013-04-15 13:43:20 +05:30
] , 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)
2013-04-18 23:26:14 +05:30
16 , & ! element 27 (2D 8node 9ip)
2013-04-15 13:43:20 +05:30
4 , & ! element 134 (3D 4node 1ip)
15 , & ! element 127 (3D 10node 4ip)
2013-04-18 23:26:14 +05:30
21 , & ! element 136 (3D 6node 6ip)
2013-04-15 13:43:20 +05:30
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 )
2019-01-24 14:42:27 +05:30
2018-09-23 18:57:51 +05:30
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
2013-04-22 00:18:59 +05:30
2013-04-18 22:10:49 +05:30
public :: &
mesh_init , &
2013-04-22 00:18:59 +05:30
mesh_build_cellnodes , &
2013-04-18 22:10:49 +05:30
mesh_build_ipVolumes , &
mesh_build_ipCoordinates , &
2013-04-22 00:18:59 +05:30
mesh_cellCenterCoordinates , &
2013-04-29 02:26:17 +05:30
mesh_get_Ncellnodes , &
2013-05-07 18:36:29 +05:30
mesh_get_unitlength , &
2018-09-23 21:27:48 +05:30
mesh_get_nodeAtIP , &
2019-01-24 14:42:27 +05:30
2013-05-08 21:22:29 +05:30
mesh_spectral_getGrid , &
2016-03-24 16:19:23 +05:30
mesh_spectral_getSize
2012-06-15 21:40:21 +05:30
private :: &
2018-09-23 21:27:48 +05:30
mesh_get_damaskOptions , &
mesh_build_cellconnectivity , &
mesh_build_ipAreas , &
mesh_faceMatch , &
mesh_build_FEdata , &
2013-04-18 22:10:49 +05:30
mesh_spectral_getHomogenization , &
2013-05-08 21:22:29 +05:30
mesh_spectral_count , &
2013-04-18 22:10:49 +05:30
mesh_spectral_count_cpSizes , &
mesh_spectral_build_nodes , &
mesh_spectral_build_elements , &
2018-09-23 21:27:48 +05:30
mesh_spectral_build_ipNeighborhood
2019-01-24 14:42:27 +05:30
2019-01-24 19:49:17 +05:30
type , public , extends ( tMesh ) :: tMesh_grid
contains
procedure :: init = > tMesh_grid_init
end type tMesh_grid
type ( tMesh_grid ) , public :: theMesh
2012-03-09 01:55:28 +05:30
contains
2007-03-21 21:48:33 +05:30
2019-01-24 19:49:17 +05:30
subroutine tMesh_grid_init ( self )
implicit none
class ( tMesh_grid ) :: self
call self % elem % init ( 10_pInt )
end subroutine tMesh_grid_init
2009-01-20 00:12:31 +05:30
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief initializes the mesh by calling all necessary private routines the mesh module
!! Order and routines strongly depend on type of solver
!--------------------------------------------------------------------------------------------------
2013-02-05 18:57:37 +05:30
subroutine mesh_init ( ip , el )
2018-02-02 17:06:09 +05:30
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
2017-10-05 20:05:34 +05:30
use , intrinsic :: iso_fortran_env , only : &
compiler_version , &
compiler_options
2018-05-17 15:34:21 +05:30
#endif
2019-01-24 14:42:27 +05:30
2018-05-17 15:34:21 +05:30
#include <petsc/finclude/petscsys.h>
use PETScsys
2019-01-24 14:42:27 +05:30
2017-02-05 04:23:22 +05:30
use DAMASK_interface
2012-06-15 21:40:21 +05:30
use IO , only : &
2015-04-11 10:39:15 +05:30
IO_open_file , &
2016-08-16 17:00:11 +05:30
IO_error , &
2015-04-11 10:39:15 +05:30
IO_timeStamp , &
IO_error , &
IO_write_jobFile
2013-10-16 18:08:00 +05:30
use debug , only : &
debug_e , &
2014-12-19 00:11:02 +05:30
debug_i , &
debug_level , &
debug_mesh , &
debug_levelBasic
2013-04-16 22:37:27 +05:30
use numerics , only : &
2013-05-07 18:36:29 +05:30
usePingPong , &
2014-12-19 00:11:02 +05:30
numerics_unitlength , &
worldrank
2012-06-15 21:40:21 +05:30
use FEsolving , only : &
2018-09-23 22:34:17 +05:30
FEsolving_execElem , &
FEsolving_execIP
2018-01-10 21:43:25 +05:30
2007-04-10 16:52:53 +05:30
implicit none
2018-05-17 15:34:21 +05:30
include 'fftw3-mpi.f03'
2016-08-16 17:00:11 +05:30
integer ( C_INTPTR_T ) :: devNull , local_K , local_K_offset
integer :: ierr , worldsize
2013-12-11 22:19:20 +05:30
integer ( pInt ) , parameter :: FILEUNIT = 222_pInt
2018-09-24 01:01:30 +05:30
integer ( pInt ) , intent ( in ) , optional :: el , ip
2013-02-08 21:25:53 +05:30
integer ( pInt ) :: j
2014-12-19 00:11:02 +05:30
logical :: myDebug
2018-01-10 21:43:25 +05:30
2016-06-29 20:29:22 +05:30
write ( 6 , '(/,a)' ) ' <<<+- mesh init -+>>>'
write ( 6 , '(a15,a)' ) ' Current time: ' , IO_timeStamp ( )
2012-02-01 00:48:55 +05:30
#include "compilation_info.f90"
2013-01-08 16:39:20 +05:30
2012-03-09 01:55:28 +05:30
call mesh_build_FEdata ! get properties of the different types of elements
2013-05-07 18:36:29 +05:30
mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh
2018-01-10 21:43:25 +05:30
2014-12-19 00:11:02 +05:30
myDebug = ( iand ( debug_level ( debug_mesh ) , debug_levelBasic ) / = 0_pInt )
2013-05-07 18:36:29 +05:30
2015-03-25 21:36:19 +05:30
call fftw_mpi_init ( )
2013-12-11 22:19:20 +05:30
call IO_open_file ( FILEUNIT , geometryFile ) ! parse info from geometry file...
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Opened geometry file' ; flush ( 6 )
2015-09-11 14:22:03 +05:30
grid = mesh_spectral_getGrid ( fileUnit )
2016-10-24 14:03:01 +05:30
call MPI_comm_size ( PETSC_COMM_WORLD , worldsize , ierr )
2016-08-16 17:00:11 +05:30
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)' )
2015-09-11 14:22:03 +05:30
geomSize = mesh_spectral_getSize ( fileUnit )
2018-10-10 03:22:54 +05:30
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
2015-09-11 14:22:03 +05:30
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 )
2015-03-25 21:36:19 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Grid partitioned' ; flush ( 6 )
2015-04-11 17:17:33 +05:30
call mesh_spectral_count ( )
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Counted nodes/elements' ; flush ( 6 )
2012-06-15 21:40:21 +05:30
call mesh_spectral_count_cpSizes
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Built CP statistics' ; flush ( 6 )
2015-04-11 17:17:33 +05:30
call mesh_spectral_build_nodes ( )
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Built nodes' ; flush ( 6 )
2013-12-11 22:19:20 +05:30
call mesh_spectral_build_elements ( FILEUNIT )
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Built elements' ; flush ( 6 )
2013-12-11 22:19:20 +05:30
call mesh_get_damaskOptions ( FILEUNIT )
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Got DAMASK options' ; flush ( 6 )
2013-04-22 00:18:59 +05:30
call mesh_build_cellconnectivity
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Built cell connectivity' ; flush ( 6 )
2013-04-24 00:00:56 +05:30
mesh_cellnode = mesh_build_cellnodes ( mesh_node , mesh_Ncellnodes )
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Built cell nodes' ; flush ( 6 )
2012-03-09 01:55:28 +05:30
call mesh_build_ipCoordinates
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Built IP coordinates' ; flush ( 6 )
2012-03-09 01:55:28 +05:30
call mesh_build_ipVolumes
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Built IP volumes' ; flush ( 6 )
2012-03-09 01:55:28 +05:30
call mesh_build_ipAreas
2014-12-19 00:11:02 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Built IP areas' ; flush ( 6 )
2015-11-26 02:25:17 +05:30
close ( FILEUNIT )
2016-06-27 21:45:56 +05:30
call mesh_spectral_build_ipNeighborhood
2012-02-13 23:11:27 +05:30
2019-01-24 14:42:27 +05:30
if ( myDebug ) write ( 6 , '(a)' ) ' Built IP neighborhood' ; flush ( 6 )
2013-04-18 22:10:49 +05:30
2013-10-16 18:08:00 +05:30
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
2018-01-10 21:43:25 +05:30
2014-01-17 07:08:35 +05:30
FEsolving_execElem = [ 1_pInt , mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements
2018-09-23 20:56:13 +05:30
allocate ( FEsolving_execIP ( 2_pInt , mesh_NcpElems ) , source = 1_pInt ) ! parallel loop bounds set to comprise from first IP...
2014-01-17 07:08:35 +05:30
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
2018-01-10 21:43:25 +05:30
2013-04-19 18:11:06 +05:30
2018-09-23 21:07:57 +05:30
!!!! 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
2018-09-23 22:20:54 +05:30
! better name
2018-10-04 09:33:48 +05:30
mesh_homogenizationAt = mesh_element ( 3 , : )
mesh_microstructureAt = mesh_element ( 4 , : )
2018-09-23 23:28:43 +05:30
mesh_CPnodeID = mesh_element ( 5 : 4 + mesh_NipsPerElem , : )
2018-09-23 21:07:57 +05:30
!!!!!!!!!!!!!!!!!!!!!!!!
2019-01-24 19:49:17 +05:30
call theMesh % init
2012-03-09 01:55:28 +05:30
end subroutine mesh_init
2009-01-20 00:12:31 +05:30
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2013-04-15 13:43:20 +05:30
!> @brief Split CP elements into cells.
2018-01-10 21:43:25 +05:30
!> @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,
2013-04-22 00:18:59 +05:30
!> all others (currently) might be stored more than once.
!> Also allocates the 'mesh_node' array.
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2013-04-22 00:18:59 +05:30
subroutine mesh_build_cellconnectivity
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
implicit none
2013-04-15 13:43:20 +05:30
integer ( pInt ) , dimension ( : ) , allocatable :: &
matchingNode2cellnode
integer ( pInt ) , dimension ( : , : ) , allocatable :: &
cellnodeParent
integer ( pInt ) , dimension ( mesh_maxNcellnodes ) :: &
localCellnode2globalCellnode
2013-10-16 18:08:00 +05:30
integer ( pInt ) :: &
2018-01-10 21:43:25 +05:30
e , t , g , c , n , i , &
2013-04-15 13:43:20 +05:30
matchingNodeID , &
localCellnodeID
2018-01-10 21:43:25 +05:30
2013-12-30 15:36:01 +05:30
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 )
2018-01-10 21:43:25 +05:30
2013-10-16 18:08:00 +05:30
!--------------------------------------------------------------------------------------------------
! Count cell nodes (including duplicates) and generate cell connectivity list
2013-04-22 00:18:59 +05:30
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
2013-04-15 13:43:20 +05:30
endif
2013-04-22 00:18:59 +05:30
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
2012-06-15 21:40:21 +05:30
enddo
enddo
2013-04-22 00:18:59 +05:30
enddo
2013-04-15 13:43:20 +05:30
2013-04-22 00:18:59 +05:30
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
2013-04-15 13:43:20 +05:30
2013-04-22 00:18:59 +05:30
end subroutine mesh_build_cellconnectivity
!--------------------------------------------------------------------------------------------------
!> @brief Calculate position of cellnodes from the given position of nodes
2018-01-10 21:43:25 +05:30
!> Build list of cellnodes' coordinates.
2013-04-22 00:18:59 +05:30
!> Cellnode coordinates are calculated from a weighted sum of node coordinates.
!--------------------------------------------------------------------------------------------------
2013-04-24 00:00:56 +05:30
function mesh_build_cellnodes ( nodes , Ncellnodes )
2018-01-10 21:43:25 +05:30
2013-04-22 00:18:59 +05:30
implicit none
2013-10-16 18:08:00 +05:30
integer ( pInt ) , intent ( in ) :: Ncellnodes !< requested number of cellnodes
2013-04-22 00:18:59 +05:30
real ( pReal ) , dimension ( 3 , mesh_Nnodes ) , intent ( in ) :: nodes
2013-04-24 00:00:56 +05:30
real ( pReal ) , dimension ( 3 , Ncellnodes ) :: mesh_build_cellnodes
2013-04-22 00:18:59 +05:30
2013-10-16 18:08:00 +05:30
integer ( pInt ) :: &
2018-01-10 21:43:25 +05:30
e , t , n , m , &
2013-04-22 00:18:59 +05:30
localCellnodeID
real ( pReal ) , dimension ( 3 ) :: &
myCoords
2018-01-10 21:43:25 +05:30
2013-04-22 00:18:59 +05:30
mesh_build_cellnodes = 0.0_pReal
2013-04-18 23:26:14 +05:30
!$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords)
2013-04-24 00:00:56 +05:30
do n = 1_pInt , Ncellnodes ! loop over cell nodes
2013-04-22 00:18:59 +05:30
e = mesh_cellnodeParent ( 1 , n )
localCellnodeID = mesh_cellnodeParent ( 2 , n )
2013-04-15 13:43:20 +05:30
t = mesh_element ( 2 , e ) ! get element type
myCoords = 0.0_pReal
do m = 1_pInt , FE_Nnodes ( t )
2013-04-22 00:18:59 +05:30
myCoords = myCoords + nodes ( 1 : 3 , mesh_element ( 4_pInt + m , e ) ) &
2013-04-15 13:43:20 +05:30
* FE_cellnodeParentnodeWeights ( m , localCellnodeID , t )
enddo
2013-04-22 00:18:59 +05:30
mesh_build_cellnodes ( 1 : 3 , n ) = myCoords / sum ( FE_cellnodeParentnodeWeights ( : , localCellnodeID , t ) )
2013-04-15 13:43:20 +05:30
enddo
2013-04-18 23:26:14 +05:30
!$OMP END PARALLEL DO
2013-04-15 13:43:20 +05:30
2013-04-22 00:18:59 +05:30
end function mesh_build_cellnodes
2011-02-16 21:53:08 +05:30
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume'
2013-04-15 13:43:20 +05:30
!> @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
2018-01-10 21:43:25 +05:30
!> calculated as an average of four tetrahedals with three corners on the cell face
2013-04-15 13:43:20 +05:30
!> and one corner at the central ip.
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
subroutine mesh_build_ipVolumes
2013-04-10 15:49:16 +05:30
use math , only : &
math_volTetrahedron , &
math_areaTriangle
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
implicit none
2013-04-15 13:43:20 +05:30
integer ( pInt ) :: e , t , g , c , i , m , f , n
real ( pReal ) , dimension ( FE_maxNcellnodesPerCellface , FE_maxNcellfaces ) :: subvolume
2011-02-16 21:53:08 +05:30
2012-06-15 21:40:21 +05:30
if ( . not . allocated ( mesh_ipVolume ) ) then
allocate ( mesh_ipVolume ( mesh_maxNips , mesh_NcpElems ) )
2018-01-10 21:43:25 +05:30
mesh_ipVolume = 0.0_pReal
2012-06-15 21:40:21 +05:30
endif
2018-01-10 21:43:25 +05:30
2013-04-15 13:43:20 +05:30
!$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
2013-04-22 00:18:59 +05:30
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 ) ) )
2018-01-10 21:43:25 +05:30
2013-04-15 13:43:20 +05:30
case ( 2_pInt ) ! 2D 4node
forall ( i = 1_pInt : FE_Nips ( g ) ) & ! loop over ips=cells in this element
2013-04-22 00:18:59 +05:30
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 ) ) )
2013-04-15 13:43:20 +05:30
case ( 3_pInt ) ! 3D 4node
forall ( i = 1_pInt : FE_Nips ( g ) ) & ! loop over ips=cells in this element
2013-04-22 00:18:59 +05:30
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 ) ) )
2013-04-15 13:43:20 +05:30
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 ( &
2013-04-22 00:18:59 +05:30
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 ) ) , &
2013-04-15 13:43:20 +05:30
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
2013-04-09 23:37:30 +05:30
enddo
2013-04-15 13:43:20 +05:30
end select
enddo
!$OMP END PARALLEL DO
2011-02-16 21:53:08 +05:30
2012-06-15 21:40:21 +05:30
end subroutine mesh_build_ipVolumes
2011-02-16 21:53:08 +05:30
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2012-11-06 20:07:13 +05:30
!> @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.
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2013-04-15 13:43:20 +05:30
! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES,
2018-01-10 21:43:25 +05:30
! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME.
! HAS TO BE CHANGED IN A LATER VERSION.
2012-11-06 20:07:13 +05:30
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
subroutine mesh_build_ipCoordinates
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
implicit none
2013-04-15 13:43:20 +05:30
integer ( pInt ) :: e , t , g , c , i , n
real ( pReal ) , dimension ( 3 ) :: myCoords
2011-02-16 21:53:08 +05:30
2017-04-25 16:04:14 +05:30
if ( . not . allocated ( mesh_ipCoordinates ) ) &
allocate ( mesh_ipCoordinates ( 3 , mesh_maxNips , mesh_NcpElems ) , source = 0.0_pReal )
2018-01-10 21:43:25 +05:30
2013-04-15 13:43:20 +05:30
!$OMP PARALLEL DO PRIVATE(t,g,c,myCoords)
2017-04-25 16:04:14 +05:30
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 ) )
2012-06-15 21:40:21 +05:30
enddo
2017-04-25 16:04:14 +05:30
mesh_ipCoordinates ( 1 : 3 , i , e ) = myCoords / real ( FE_NcellnodesPerCell ( c ) , pReal )
2012-06-15 21:40:21 +05:30
enddo
2017-04-25 16:04:14 +05:30
enddo
2012-11-09 13:17:14 +05:30
!$OMP END PARALLEL DO
2011-02-16 21:53:08 +05:30
2012-06-15 21:40:21 +05:30
end subroutine mesh_build_ipCoordinates
2007-03-26 14:20:57 +05:30
2012-03-09 01:55:28 +05:30
2012-11-06 20:07:13 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Calculates cell center coordinates.
!--------------------------------------------------------------------------------------------------
2013-04-15 13:43:20 +05:30
pure function mesh_cellCenterCoordinates ( ip , el )
2018-01-10 21:43:25 +05:30
2013-05-08 21:22:29 +05:30
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
2018-01-10 21:43:25 +05:30
2013-05-08 21:22:29 +05:30
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
2017-04-25 16:04:14 +05:30
mesh_cellCenterCoordinates = mesh_cellCenterCoordinates / real ( FE_NcellnodesPerCell ( c ) , pReal )
2012-11-06 20:07:13 +05:30
2013-05-08 21:22:29 +05:30
end function mesh_cellCenterCoordinates
2012-11-06 20:07:13 +05:30
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief Reads grid information from geometry file. If fileUnit is given,
2012-06-15 21:40:21 +05:30
!! assumes an opened file, otherwise tries to open the one specified in geometryFile
!--------------------------------------------------------------------------------------------------
2013-04-08 19:52:32 +05:30
function mesh_spectral_getGrid ( fileUnit )
2012-06-15 21:40:21 +05:30
use IO , only : &
IO_checkAndRewind , &
IO_open_file , &
2015-08-28 13:08:48 +05:30
IO_stringPos , &
2012-06-15 21:40:21 +05:30
IO_lc , &
IO_stringValue , &
IO_intValue , &
IO_floatValue , &
IO_error
use DAMASK_interface , only : &
geometryFile
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
implicit none
2013-04-08 19:52:32 +05:30
integer ( pInt ) , dimension ( 3 ) :: mesh_spectral_getGrid
integer ( pInt ) , intent ( in ) , optional :: fileUnit
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2013-04-08 19:52:32 +05:30
integer ( pInt ) :: headerLength = 0_pInt
2012-06-15 21:40:21 +05:30
character ( len = 1024 ) :: line , &
keyword
2013-12-11 22:19:20 +05:30
integer ( pInt ) :: i , j , myFileUnit
2013-04-08 19:52:32 +05:30
logical :: gotGrid = . false .
2018-01-10 21:43:25 +05:30
2013-04-08 19:52:32 +05:30
mesh_spectral_getGrid = - 1_pInt
2012-06-15 21:40:21 +05:30
if ( . not . present ( fileUnit ) ) then
2013-12-11 22:19:20 +05:30
myFileUnit = 289_pInt
call IO_open_file ( myFileUnit , trim ( geometryFile ) )
2012-06-15 21:40:21 +05:30
else
2013-12-11 22:19:20 +05:30
myFileUnit = fileUnit
2012-06-15 21:40:21 +05:30
endif
2018-01-10 21:43:25 +05:30
2013-12-11 22:19:20 +05:30
call IO_checkAndRewind ( myFileUnit )
2012-02-21 21:09:36 +05:30
2013-12-11 22:19:20 +05:30
read ( myFileUnit , '(a1024)' ) line
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
keyword = IO_lc ( IO_StringValue ( line , chunkPos , 2_pInt , . true . ) )
2012-06-15 21:40:21 +05:30
if ( keyword ( 1 : 4 ) == 'head' ) then
2015-08-28 13:08:48 +05:30
headerLength = IO_intValue ( line , chunkPos , 1_pInt ) + 1_pInt
2012-06-15 21:40:21 +05:30
else
2013-04-08 19:52:32 +05:30
call IO_error ( error_ID = 841_pInt , ext_msg = 'mesh_spectral_getGrid' )
2012-06-15 21:40:21 +05:30
endif
2013-12-11 22:19:20 +05:30
rewind ( myFileUnit )
2012-06-15 21:40:21 +05:30
do i = 1_pInt , headerLength
2013-12-11 22:19:20 +05:30
read ( myFileUnit , '(a1024)' ) line
2018-01-10 21:43:25 +05:30
chunkPos = IO_stringPos ( line )
2015-08-28 13:08:48 +05:30
select case ( IO_lc ( IO_StringValue ( line , chunkPos , 1_pInt , . true . ) ) )
2015-03-13 04:00:24 +05:30
case ( 'grid' )
2013-04-08 19:52:32 +05:30
gotGrid = . true .
2012-06-15 21:40:21 +05:30
do j = 2_pInt , 6_pInt , 2_pInt
2015-08-28 13:08:48 +05:30
select case ( IO_lc ( IO_stringValue ( line , chunkPos , j ) ) )
2012-06-15 21:40:21 +05:30
case ( 'a' )
2015-08-28 13:08:48 +05:30
mesh_spectral_getGrid ( 1 ) = IO_intValue ( line , chunkPos , j + 1_pInt )
2012-06-15 21:40:21 +05:30
case ( 'b' )
2015-08-28 13:08:48 +05:30
mesh_spectral_getGrid ( 2 ) = IO_intValue ( line , chunkPos , j + 1_pInt )
2012-06-15 21:40:21 +05:30
case ( 'c' )
2015-08-28 13:08:48 +05:30
mesh_spectral_getGrid ( 3 ) = IO_intValue ( line , chunkPos , j + 1_pInt )
2012-06-15 21:40:21 +05:30
end select
enddo
end select
enddo
2018-01-10 21:43:25 +05:30
2013-12-11 22:19:20 +05:30
if ( . not . present ( fileUnit ) ) close ( myFileUnit )
2018-01-10 21:43:25 +05:30
2013-04-08 19:52:32 +05:30
if ( . not . gotGrid ) &
call IO_error ( error_ID = 845_pInt , ext_msg = 'grid' )
2013-04-10 15:49:16 +05:30
if ( any ( mesh_spectral_getGrid < 1_pInt ) ) &
2013-04-08 19:52:32 +05:30
call IO_error ( error_ID = 843_pInt , ext_msg = 'mesh_spectral_getGrid' )
2012-02-21 21:09:36 +05:30
2013-04-08 19:52:32 +05:30
end function mesh_spectral_getGrid
2012-02-21 21:09:36 +05:30
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief Reads size information from geometry file. If fileUnit is given,
2012-06-15 21:40:21 +05:30
!! assumes an opened file, otherwise tries to open the one specified in geometryFile
!--------------------------------------------------------------------------------------------------
2013-04-08 19:52:32 +05:30
function mesh_spectral_getSize ( fileUnit )
2012-06-15 21:40:21 +05:30
use IO , only : &
IO_checkAndRewind , &
IO_open_file , &
2015-08-28 13:08:48 +05:30
IO_stringPos , &
2012-06-15 21:40:21 +05:30
IO_lc , &
IO_stringValue , &
IO_intValue , &
IO_floatValue , &
IO_error
use DAMASK_interface , only : &
geometryFile
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
implicit none
2013-04-08 19:52:32 +05:30
real ( pReal ) , dimension ( 3 ) :: mesh_spectral_getSize
integer ( pInt ) , intent ( in ) , optional :: fileUnit
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2013-04-08 19:52:32 +05:30
integer ( pInt ) :: headerLength = 0_pInt
2012-06-15 21:40:21 +05:30
character ( len = 1024 ) :: line , &
keyword
2018-01-10 21:43:25 +05:30
integer ( pInt ) :: i , j , myFileUnit
2013-04-08 19:52:32 +05:30
logical :: gotSize = . false .
2018-01-10 21:43:25 +05:30
2013-04-08 19:52:32 +05:30
mesh_spectral_getSize = - 1.0_pReal
2012-06-15 21:40:21 +05:30
if ( . not . present ( fileUnit ) ) then
2013-12-11 22:19:20 +05:30
myFileUnit = 289_pInt
call IO_open_file ( myFileUnit , trim ( geometryFile ) )
2012-06-15 21:40:21 +05:30
else
2013-12-11 22:19:20 +05:30
myFileUnit = fileUnit
2012-06-15 21:40:21 +05:30
endif
2018-01-10 21:43:25 +05:30
2013-12-11 22:19:20 +05:30
call IO_checkAndRewind ( myFileUnit )
2012-02-21 21:09:36 +05:30
2013-12-11 22:19:20 +05:30
read ( myFileUnit , '(a1024)' ) line
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
keyword = IO_lc ( IO_StringValue ( line , chunkPos , 2_pInt , . true . ) )
2012-06-15 21:40:21 +05:30
if ( keyword ( 1 : 4 ) == 'head' ) then
2015-08-28 13:08:48 +05:30
headerLength = IO_intValue ( line , chunkPos , 1_pInt ) + 1_pInt
2012-06-15 21:40:21 +05:30
else
2013-04-08 19:52:32 +05:30
call IO_error ( error_ID = 841_pInt , ext_msg = 'mesh_spectral_getSize' )
2012-06-15 21:40:21 +05:30
endif
2013-12-11 22:19:20 +05:30
rewind ( myFileUnit )
2012-06-15 21:40:21 +05:30
do i = 1_pInt , headerLength
2013-12-11 22:19:20 +05:30
read ( myFileUnit , '(a1024)' ) line
2018-01-10 21:43:25 +05:30
chunkPos = IO_stringPos ( line )
2015-08-28 13:08:48 +05:30
select case ( IO_lc ( IO_StringValue ( line , chunkPos , 1 , . true . ) ) )
2015-03-13 04:00:24 +05:30
case ( 'size' )
2013-04-08 19:52:32 +05:30
gotSize = . true .
2012-06-15 21:40:21 +05:30
do j = 2_pInt , 6_pInt , 2_pInt
2015-08-28 13:08:48 +05:30
select case ( IO_lc ( IO_stringValue ( line , chunkPos , j ) ) )
2012-06-15 21:40:21 +05:30
case ( 'x' )
2015-08-28 13:08:48 +05:30
mesh_spectral_getSize ( 1 ) = IO_floatValue ( line , chunkPos , j + 1_pInt )
2012-06-15 21:40:21 +05:30
case ( 'y' )
2015-08-28 13:08:48 +05:30
mesh_spectral_getSize ( 2 ) = IO_floatValue ( line , chunkPos , j + 1_pInt )
2012-06-15 21:40:21 +05:30
case ( 'z' )
2015-08-28 13:08:48 +05:30
mesh_spectral_getSize ( 3 ) = IO_floatValue ( line , chunkPos , j + 1_pInt )
2012-06-15 21:40:21 +05:30
end select
enddo
end select
enddo
2018-01-10 21:43:25 +05:30
2013-12-11 22:19:20 +05:30
if ( . not . present ( fileUnit ) ) close ( myFileUnit )
2012-02-21 21:09:36 +05:30
2013-04-08 19:52:32 +05:30
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' )
2012-02-21 21:09:36 +05:30
2013-04-08 19:52:32 +05:30
end function mesh_spectral_getSize
2012-02-21 21:09:36 +05:30
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2018-01-10 21:43:25 +05:30
!> @brief Reads homogenization information from geometry file. If fileUnit is given,
2012-06-15 21:40:21 +05:30
!! assumes an opened file, otherwise tries to open the one specified in geometryFile
!--------------------------------------------------------------------------------------------------
2013-04-08 19:52:32 +05:30
integer ( pInt ) function mesh_spectral_getHomogenization ( fileUnit )
2012-06-15 21:40:21 +05:30
use IO , only : &
IO_checkAndRewind , &
IO_open_file , &
2015-08-28 13:08:48 +05:30
IO_stringPos , &
2012-06-15 21:40:21 +05:30
IO_lc , &
IO_stringValue , &
IO_intValue , &
IO_error
use DAMASK_interface , only : &
geometryFile
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
implicit none
2013-04-08 19:52:32 +05:30
integer ( pInt ) , intent ( in ) , optional :: fileUnit
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2013-04-08 19:52:32 +05:30
integer ( pInt ) :: headerLength = 0_pInt
2012-06-15 21:40:21 +05:30
character ( len = 1024 ) :: line , &
keyword
2013-12-11 22:19:20 +05:30
integer ( pInt ) :: i , myFileUnit
2012-06-15 21:40:21 +05:30
logical :: gotHomogenization = . false .
2018-01-10 21:43:25 +05:30
2013-02-11 16:13:45 +05:30
mesh_spectral_getHomogenization = - 1_pInt
2012-06-15 21:40:21 +05:30
if ( . not . present ( fileUnit ) ) then
2013-12-11 22:19:20 +05:30
myFileUnit = 289_pInt
call IO_open_file ( myFileUnit , trim ( geometryFile ) )
2012-06-15 21:40:21 +05:30
else
2013-12-11 22:19:20 +05:30
myFileUnit = fileUnit
2012-06-15 21:40:21 +05:30
endif
2018-01-10 21:43:25 +05:30
2013-12-11 22:19:20 +05:30
call IO_checkAndRewind ( myFileUnit )
2012-02-21 21:09:36 +05:30
2013-12-11 22:19:20 +05:30
read ( myFileUnit , '(a1024)' ) line
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
keyword = IO_lc ( IO_StringValue ( line , chunkPos , 2_pInt , . true . ) )
2012-06-15 21:40:21 +05:30
if ( keyword ( 1 : 4 ) == 'head' ) then
2015-08-28 13:08:48 +05:30
headerLength = IO_intValue ( line , chunkPos , 1_pInt ) + 1_pInt
2012-06-15 21:40:21 +05:30
else
call IO_error ( error_ID = 841_pInt , ext_msg = 'mesh_spectral_getHomogenization' )
endif
2013-12-11 22:19:20 +05:30
rewind ( myFileUnit )
2012-06-15 21:40:21 +05:30
do i = 1_pInt , headerLength
2013-12-11 22:19:20 +05:30
read ( myFileUnit , '(a1024)' ) line
2018-01-10 21:43:25 +05:30
chunkPos = IO_stringPos ( line )
2015-08-28 13:08:48 +05:30
select case ( IO_lc ( IO_StringValue ( line , chunkPos , 1 , . true . ) ) )
2012-06-15 21:40:21 +05:30
case ( 'homogenization' )
gotHomogenization = . true .
2015-08-28 13:08:48 +05:30
mesh_spectral_getHomogenization = IO_intValue ( line , chunkPos , 2_pInt )
2012-06-15 21:40:21 +05:30
end select
enddo
2018-01-10 21:43:25 +05:30
2013-12-11 22:19:20 +05:30
if ( . not . present ( fileUnit ) ) close ( myFileUnit )
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
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' )
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
end function mesh_spectral_getHomogenization
2013-02-08 21:25:53 +05:30
2012-08-27 13:34:47 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Count overall number of nodes and elements in mesh and stores them in
2013-05-08 21:22:29 +05:30
!! 'mesh_Nelems', 'mesh_Nnodes' and 'mesh_NcpElems'
2012-08-27 13:34:47 +05:30
!--------------------------------------------------------------------------------------------------
2015-04-11 17:17:33 +05:30
subroutine mesh_spectral_count ( )
2015-03-25 21:36:19 +05:30
2012-08-27 13:34:47 +05:30
implicit none
2018-09-23 20:35:01 +05:30
mesh_NcpElems = product ( grid ( 1 : 2 ) ) * grid3
2015-09-11 14:22:03 +05:30
mesh_Nnodes = product ( grid ( 1 : 2 ) + 1_pInt ) * ( grid3 + 1_pInt )
2018-01-10 21:43:25 +05:30
2015-09-11 14:22:03 +05:30
mesh_NcpElemsGlobal = product ( grid )
2012-08-27 13:34:47 +05:30
2013-05-08 21:22:29 +05:30
end subroutine mesh_spectral_count
2012-08-27 13:34:47 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements.
2018-09-23 19:27:21 +05:30
!! Sets global values 'mesh_maxNips', 'mesh_maxNipNeighbors',
2014-12-15 17:21:32 +05:30
!! and 'mesh_maxNcellnodes'
2012-08-27 13:34:47 +05:30
!--------------------------------------------------------------------------------------------------
subroutine mesh_spectral_count_cpSizes
2018-01-10 21:43:25 +05:30
2012-08-27 13:34:47 +05:30
implicit none
2013-04-15 13:43:20 +05:30
integer ( pInt ) :: t , g , c
2018-01-10 21:43:25 +05:30
2019-01-24 19:49:17 +05:30
t = 10_pInt
2013-04-15 13:43:20 +05:30
g = FE_geomtype ( t )
c = FE_celltype ( g )
2012-08-27 13:34:47 +05:30
2013-04-15 13:43:20 +05:30
mesh_maxNips = FE_Nips ( g )
mesh_maxNipNeighbors = FE_NipNeighbors ( c )
mesh_maxNcellnodes = FE_Ncellnodes ( g )
2012-08-27 13:34:47 +05:30
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'
!--------------------------------------------------------------------------------------------------
2015-04-11 17:17:33 +05:30
subroutine mesh_spectral_build_nodes ( )
2012-08-27 13:34:47 +05:30
implicit none
2015-04-11 17:17:33 +05:30
integer ( pInt ) :: n
2012-08-27 13:34:47 +05:30
2013-05-08 21:22:29 +05:30
allocate ( mesh_node0 ( 3 , mesh_Nnodes ) , source = 0.0_pReal )
allocate ( mesh_node ( 3 , mesh_Nnodes ) , source = 0.0_pReal )
2018-01-10 21:43:25 +05:30
2015-03-27 02:49:28 +05:30
forall ( n = 0_pInt : mesh_Nnodes - 1_pInt )
mesh_node0 ( 1 , n + 1_pInt ) = mesh_unitlength * &
2015-09-11 14:22:03 +05:30
geomSize ( 1 ) * real ( mod ( n , ( grid ( 1 ) + 1_pInt ) ) , pReal ) &
/ real ( grid ( 1 ) , pReal )
2015-03-27 02:49:28 +05:30
mesh_node0 ( 2 , n + 1_pInt ) = mesh_unitlength * &
2015-09-11 14:22:03 +05:30
geomSize ( 2 ) * real ( mod ( n / ( grid ( 1 ) + 1_pInt ) , ( grid ( 2 ) + 1_pInt ) ) , pReal ) &
/ real ( grid ( 2 ) , pReal )
2015-03-27 02:49:28 +05:30
mesh_node0 ( 3 , n + 1_pInt ) = mesh_unitlength * &
2015-09-11 14:22:03 +05:30
size3 * real ( mod ( n / ( grid ( 1 ) + 1_pInt ) / ( grid ( 2 ) + 1_pInt ) , ( grid3 + 1_pInt ) ) , pReal ) &
/ real ( grid3 , pReal ) + &
2018-01-10 21:43:25 +05:30
size3offset
end forall
2012-08-27 13:34:47 +05:30
2013-04-18 22:10:49 +05:30
mesh_node = mesh_node0
2012-08-27 13:34:47 +05:30
end subroutine mesh_spectral_build_nodes
!--------------------------------------------------------------------------------------------------
!> @brief Store FEid, type, material, texture, and node list per element.
!! Allocates global array 'mesh_element'
2013-06-11 22:05:04 +05:30
!> @todo does the IO_error makes sense?
2012-08-27 13:34:47 +05:30
!--------------------------------------------------------------------------------------------------
2013-12-11 22:19:20 +05:30
subroutine mesh_spectral_build_elements ( fileUnit )
2012-08-27 13:34:47 +05:30
use IO , only : &
IO_checkAndRewind , &
IO_lc , &
IO_stringValue , &
2015-08-28 13:08:48 +05:30
IO_stringPos , &
2012-08-27 13:34:47 +05:30
IO_error , &
IO_continuousIntValues , &
IO_intValue , &
IO_countContinuousIntValues
implicit none
2013-05-08 21:22:29 +05:30
integer ( pInt ) , intent ( in ) :: &
2013-12-11 22:19:20 +05:30
fileUnit
2015-08-28 13:08:48 +05:30
integer ( pInt ) , allocatable , dimension ( : ) :: chunkPos
2013-05-08 21:22:29 +05:30
integer ( pInt ) :: &
e , i , &
headerLength = 0_pInt , &
2018-10-10 03:22:54 +05:30
maxDataPerLine , &
2014-05-15 14:22:16 +05:30
homog , &
2015-03-25 21:36:19 +05:30
elemType , &
elemOffset
2013-05-08 21:22:29 +05:30
integer ( pInt ) , dimension ( : ) , allocatable :: &
2015-03-25 21:36:19 +05:30
microstructures , &
2018-09-23 22:20:54 +05:30
microGlobal
2013-05-08 21:22:29 +05:30
integer ( pInt ) , dimension ( 1 , 1 ) :: &
dummySet = 0_pInt
character ( len = 65536 ) :: &
line , &
keyword
character ( len = 64 ) , dimension ( 1 ) :: &
dummyName = ''
2013-12-11 22:19:20 +05:30
homog = mesh_spectral_getHomogenization ( fileUnit )
2012-08-27 13:34:47 +05:30
2014-12-19 00:11:02 +05:30
!--------------------------------------------------------------------------------------------------
! get header length
call IO_checkAndRewind ( fileUnit )
2013-12-11 22:19:20 +05:30
read ( fileUnit , '(a65536)' ) line
2015-08-28 13:08:48 +05:30
chunkPos = IO_stringPos ( line )
keyword = IO_lc ( IO_StringValue ( line , chunkPos , 2_pInt , . true . ) )
2012-08-27 13:34:47 +05:30
if ( keyword ( 1 : 4 ) == 'head' ) then
2015-08-28 13:08:48 +05:30
headerLength = IO_intValue ( line , chunkPos , 1_pInt ) + 1_pInt
2012-08-27 13:34:47 +05:30
else
call IO_error ( error_ID = 841_pInt , ext_msg = 'mesh_spectral_build_elements' )
endif
2018-01-10 21:43:25 +05:30
2014-12-19 00:11:02 +05:30
!--------------------------------------------------------------------------------------------------
! get maximum microstructure index
call IO_checkAndRewind ( fileUnit )
2012-08-27 13:34:47 +05:30
do i = 1_pInt , headerLength
2013-12-11 22:19:20 +05:30
read ( fileUnit , '(a65536)' ) line
2012-08-27 13:34:47 +05:30
enddo
2018-10-10 03:22:54 +05:30
maxDataPerLine = 0_pInt
2012-08-27 13:34:47 +05:30
i = 1_pInt
do while ( i > 0_pInt )
2013-12-11 22:19:20 +05:30
i = IO_countContinuousIntValues ( fileUnit )
2018-10-10 03:22:54 +05:30
maxDataPerLine = max ( maxDataPerLine , i ) ! found a longer line?
2012-08-27 13:34:47 +05:30
enddo
2018-09-23 23:28:43 +05:30
allocate ( mesh_element ( 4_pInt + 8_pInt , mesh_NcpElems ) , source = 0_pInt )
2018-10-10 03:22:54 +05:30
allocate ( microstructures ( 1_pInt + maxDataPerLine ) , source = 1_pInt ) ! prepare to receive counter and max data size
allocate ( microGlobal ( mesh_NcpElemsGlobal ) , source = 1_pInt )
2012-08-27 13:34:47 +05:30
2014-12-19 00:11:02 +05:30
!--------------------------------------------------------------------------------------------------
! read in microstructures
call IO_checkAndRewind ( fileUnit )
do i = 1_pInt , headerLength
2013-12-11 22:19:20 +05:30
read ( fileUnit , '(a65536)' ) line
2012-08-27 13:34:47 +05:30
enddo
2018-01-10 21:43:25 +05:30
2012-08-27 13:34:47 +05:30
e = 0_pInt
2015-03-25 21:36:19 +05:30
do while ( e < mesh_NcpElemsGlobal . and . microstructures ( 1 ) > 0_pInt ) ! fill expected number of elements, stop at end of data (or blank line!)
2018-10-10 03:22:54 +05:30
microstructures = IO_continuousIntValues ( fileUnit , maxDataPerLine , dummyName , dummySet , 0_pInt ) ! get affected elements
2012-08-27 13:34:47 +05:30
do i = 1_pInt , microstructures ( 1_pInt )
e = e + 1_pInt ! valid element entry
2018-09-23 22:20:54 +05:30
microGlobal ( e ) = microstructures ( 1_pInt + i )
2012-08-27 13:34:47 +05:30
enddo
enddo
2019-01-24 19:49:17 +05:30
elemType = 10_pInt
2015-09-11 14:22:03 +05:30
elemOffset = product ( grid ( 1 : 2 ) ) * grid3Offset
2015-03-25 21:36:19 +05:30
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
2018-09-23 22:10:14 +05:30
mesh_element ( 1 , e ) = - 1_pInt ! DEPRECATED
2015-03-25 21:36:19 +05:30
mesh_element ( 2 , e ) = elemType ! elem type
mesh_element ( 3 , e ) = homog ! homogenization
2018-09-23 22:20:54 +05:30
mesh_element ( 4 , e ) = microGlobal ( e + elemOffset ) ! microstructure
2015-09-11 14:22:03 +05:30
mesh_element ( 5 , e ) = e + ( e - 1_pInt ) / grid ( 1 ) + &
( ( e - 1_pInt ) / ( grid ( 1 ) * grid ( 2 ) ) ) * ( grid ( 1 ) + 1_pInt ) ! base node
2015-03-25 21:36:19 +05:30
mesh_element ( 6 , e ) = mesh_element ( 5 , e ) + 1_pInt
2015-09-11 14:22:03 +05:30
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
2015-03-25 21:36:19 +05:30
mesh_element ( 10 , e ) = mesh_element ( 9 , e ) + 1_pInt
2015-09-11 14:22:03 +05:30
mesh_element ( 11 , e ) = mesh_element ( 9 , e ) + grid ( 1 ) + 2_pInt
mesh_element ( 12 , e ) = mesh_element ( 9 , e ) + grid ( 1 ) + 1_pInt
2015-03-25 21:36:19 +05:30
mesh_maxValStateVar ( 1 ) = max ( mesh_maxValStateVar ( 1 ) , mesh_element ( 3 , e ) ) ! needed for statistics
2018-01-10 21:43:25 +05:30
mesh_maxValStateVar ( 2 ) = max ( mesh_maxValStateVar ( 2 ) , mesh_element ( 4 , e ) )
2015-03-25 21:36:19 +05:30
enddo
2013-06-11 22:05:04 +05:30
if ( e / = mesh_NcpElems ) call IO_error ( 880_pInt , e )
2012-08-27 13:34:47 +05:30
end subroutine mesh_spectral_build_elements
2012-02-21 21:09:36 +05:30
2013-04-22 14:31:58 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief build neighborhood relations for spectral
!> @details assign globals: mesh_ipNeighborhood
!--------------------------------------------------------------------------------------------------
2016-06-27 21:45:56 +05:30
subroutine mesh_spectral_build_ipNeighborhood
2013-05-08 21:22:29 +05:30
implicit none
integer ( pInt ) :: &
x , y , z , &
e
allocate ( mesh_ipNeighborhood ( 3 , mesh_maxNipNeighbors , mesh_maxNips , mesh_NcpElems ) , source = 0_pInt )
2018-01-10 21:43:25 +05:30
2013-05-08 21:22:29 +05:30
e = 0_pInt
2015-09-11 14:22:03 +05:30
do z = 0_pInt , grid3 - 1_pInt
do y = 0_pInt , grid ( 2 ) - 1_pInt
do x = 0_pInt , grid ( 1 ) - 1_pInt
2013-05-08 21:22:29 +05:30
e = e + 1_pInt
2015-09-11 14:22:03 +05:30
mesh_ipNeighborhood ( 1 , 1 , 1 , e ) = z * grid ( 1 ) * grid ( 2 ) &
+ y * grid ( 1 ) &
+ modulo ( x + 1_pInt , grid ( 1 ) ) &
2013-05-08 21:22:29 +05:30
+ 1_pInt
2015-09-11 14:22:03 +05:30
mesh_ipNeighborhood ( 1 , 2 , 1 , e ) = z * grid ( 1 ) * grid ( 2 ) &
+ y * grid ( 1 ) &
+ modulo ( x - 1_pInt , grid ( 1 ) ) &
2013-05-08 21:22:29 +05:30
+ 1_pInt
2015-09-11 14:22:03 +05:30
mesh_ipNeighborhood ( 1 , 3 , 1 , e ) = z * grid ( 1 ) * grid ( 2 ) &
+ modulo ( y + 1_pInt , grid ( 2 ) ) * grid ( 1 ) &
2013-05-08 21:22:29 +05:30
+ x &
+ 1_pInt
2015-09-11 14:22:03 +05:30
mesh_ipNeighborhood ( 1 , 4 , 1 , e ) = z * grid ( 1 ) * grid ( 2 ) &
+ modulo ( y - 1_pInt , grid ( 2 ) ) * grid ( 1 ) &
2013-05-08 21:22:29 +05:30
+ x &
+ 1_pInt
2015-09-11 14:22:03 +05:30
mesh_ipNeighborhood ( 1 , 5 , 1 , e ) = modulo ( z + 1_pInt , grid3 ) * grid ( 1 ) * grid ( 2 ) &
+ y * grid ( 1 ) &
2013-05-08 21:22:29 +05:30
+ x &
+ 1_pInt
2015-09-11 14:22:03 +05:30
mesh_ipNeighborhood ( 1 , 6 , 1 , e ) = modulo ( z - 1_pInt , grid3 ) * grid ( 1 ) * grid ( 2 ) &
+ y * grid ( 1 ) &
2013-05-08 21:22:29 +05:30
+ 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
2013-04-22 14:31:58 +05:30
end subroutine mesh_spectral_build_ipNeighborhood
2013-01-31 21:58:08 +05:30
!--------------------------------------------------------------------------------------------------
!> @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
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
implicit none
2013-01-31 21:58:08 +05:30
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
2018-01-10 21:43:25 +05:30
2013-01-31 21:58:08 +05:30
!--------------------------------------------------------------------------------------------------
! 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
2012-08-27 13:34:47 +05:30
endif
2012-02-21 21:09:36 +05:30
2013-01-31 21:58:08 +05:30
!--------------------------------------------------------------------------------------------------
! 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
2013-04-18 22:10:49 +05:30
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
2013-01-31 21:58:08 +05:30
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 ) = &
2017-04-25 16:04:14 +05:30
centres ( 1 : 3 , lookup ( 1 ) + 1_pInt , lookup ( 2 ) + 1_pInt , lookup ( 3 ) + 1_pInt ) &
- math_mul33x3 ( Favg , real ( shift , pReal ) * gDim )
2012-08-27 13:34:47 +05:30
endif
enddo ; enddo ; enddo
2018-01-10 21:43:25 +05:30
2013-01-31 21:58:08 +05:30
!--------------------------------------------------------------------------------------------------
! 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
2012-08-27 13:34:47 +05:30
nodes = nodes / 8.0_pReal
2013-01-31 21:58:08 +05:30
end function mesh_nodesAroundCentres
2010-05-06 22:10:47 +05:30
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2019-01-24 14:42:27 +05:30
!> @brief get any additional damask options from input file, sets mesh_periodicSurface
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2019-01-24 14:42:27 +05:30
subroutine mesh_get_damaskOptions ( fileUnit )
2009-01-20 00:12:31 +05:30
2019-01-24 14:42:27 +05:30
use IO , only : &
IO_lc , &
IO_stringValue , &
IO_stringPos
2018-01-10 21:43:25 +05:30
2007-04-25 13:03:24 +05:30
implicit none
2013-12-11 22:19:20 +05:30
integer ( pInt ) , intent ( in ) :: fileUnit
2018-01-10 21:43:25 +05:30
2009-01-20 00:12:31 +05:30
2019-01-24 14:42:27 +05:30
mesh_periodicSurface = . true .
2009-01-20 00:12:31 +05:30
2019-01-24 14:42:27 +05:30
end subroutine mesh_get_damaskOptions
2009-10-12 21:31:49 +05:30
2012-03-09 01:55:28 +05:30
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2019-01-24 14:42:27 +05:30
!> @brief calculation of IP interface areas, allocate globals '_ipArea', and '_ipAreaNormal'
2012-06-15 21:40:21 +05:30
!--------------------------------------------------------------------------------------------------
2019-01-24 14:42:27 +05:30
subroutine mesh_build_ipAreas
use math , only : &
math_crossproduct
2012-06-15 21:40:21 +05:30
2007-04-10 16:52:53 +05:30
implicit none
2019-01-24 14:42:27 +05:30
integer ( pInt ) :: e , t , g , c , i , f , n , m
real ( pReal ) , dimension ( 3 , FE_maxNcellnodesPerCellface ) :: nodePos , normals
real ( pReal ) , dimension ( 3 ) :: normal
2012-06-15 21:40:21 +05:30
2019-01-24 14:42:27 +05:30
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 )
2012-06-15 21:40:21 +05:30
2019-01-24 14:42:27 +05:30
!$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 )
2009-01-20 00:12:31 +05:30
2019-01-24 14:42:27 +05:30
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
2018-02-02 19:36:13 +05:30
enddo
2009-10-12 21:31:49 +05:30
2019-01-24 14:42:27 +05:30
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
2009-10-12 21:31:49 +05:30
2019-01-24 14:42:27 +05:30
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
2009-10-12 21:31:49 +05:30
2019-01-24 14:42:27 +05:30
end select
enddo
!$OMP END PARALLEL DO
2018-01-10 21:43:25 +05:30
2015-04-11 17:17:33 +05:30
end subroutine mesh_build_ipAreas
2018-01-10 21:43:25 +05:30
2012-04-24 22:32:27 +05:30
2013-04-18 22:10:49 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief find face-matching element of same type
!--------------------------------------------------------------------------------------------------
2012-06-15 21:40:21 +05:30
subroutine mesh_faceMatch ( elem , face , matchingElem , matchingFace )
2012-05-08 20:27:06 +05:30
2012-06-15 21:40:21 +05:30
implicit none
integer ( pInt ) , intent ( out ) :: matchingElem , & ! matching CP element ID
2018-01-10 21:43:25 +05:30
matchingFace ! matching face ID
2013-04-22 00:18:59 +05:30
integer ( pInt ) , intent ( in ) :: face , & ! face ID
elem ! CP elem ID
2013-04-15 13:43:20 +05:30
integer ( pInt ) , dimension ( FE_NmatchingNodesPerFace ( face , FE_geomtype ( mesh_element ( 2 , elem ) ) ) ) :: &
2012-06-15 21:40:21 +05:30
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
2012-04-24 22:32:27 +05:30
2012-06-15 21:40:21 +05:30
matchingElem = 0_pInt
matchingFace = 0_pInt
minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case
2012-11-16 04:15:20 +05:30
myType = FE_geomtype ( mesh_element ( 2_pInt , elem ) ) ! figure elemGeomType
2012-05-08 20:27:06 +05:30
2013-04-15 13:43:20 +05:30
do n = 1_pInt , FE_NmatchingNodesPerFace ( face , myType ) ! loop over nodes on face
2013-04-22 00:18:59 +05:30
myFaceNodes ( n ) = mesh_element ( 4_pInt + FE_face ( n , face , myType ) , elem ) ! CP id of face node
2012-06-15 21:40:21 +05:30
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
2012-05-08 20:27:06 +05:30
2012-06-15 21:40:21 +05:30
allocate ( element_seen ( minNsharedElems ) )
element_seen = 0_pInt
2012-05-08 20:27:06 +05:30
2012-06-15 21:40:21 +05:30
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
2012-11-16 04:15:20 +05:30
candidateType = FE_geomtype ( mesh_element ( 2_pInt , candidateElem ) ) ! figure elemGeomType of candidate
2012-06-15 21:40:21 +05:30
checkCandidateFace : do candidateFace = 1_pInt , FE_maxNipNeighbors ! check each face of candidate
2013-04-15 13:43:20 +05:30
if ( FE_NmatchingNodesPerFace ( candidateFace , candidateType ) &
/ = FE_NmatchingNodesPerFace ( face , myType ) & ! incompatible face
2012-11-16 04:15:20 +05:30
. or . ( candidateElem == elem . and . candidateFace == face ) ) then ! this is my face
2012-06-15 21:40:21 +05:30
cycle checkCandidateFace
endif
checkTwins = . false .
2013-04-15 13:43:20 +05:30
do n = 1_pInt , FE_NmatchingNodesPerFace ( candidateFace , candidateType ) ! loop through nodes on face
2013-04-22 00:18:59 +05:30
candidateFaceNode = mesh_element ( 4_pInt + FE_face ( n , candidateFace , candidateType ) , candidateElem )
2013-04-15 13:43:20 +05:30
if ( all ( myFaceNodes / = candidateFaceNode ) ) then ! candidate node does not match any of my face nodes
checkTwins = . true . ! perhaps the twin nodes do match
2012-06-15 21:40:21 +05:30
exit
endif
enddo
if ( checkTwins ) then
checkCandidateFaceTwins : do dir = 1_pInt , 3_pInt
2013-04-15 13:43:20 +05:30
do n = 1_pInt , FE_NmatchingNodesPerFace ( candidateFace , candidateType ) ! loop through nodes on face
2013-04-22 00:18:59 +05:30
candidateFaceNode = mesh_element ( 4 + FE_face ( n , candidateFace , candidateType ) , candidateElem )
2013-04-15 13:43:20 +05:30
if ( all ( myFaceNodes / = mesh_nodeTwins ( dir , candidateFaceNode ) ) ) then ! node twin does not match either
2012-06-15 21:40:21 +05:30
if ( dir == 3_pInt ) then
cycle checkCandidateFace
else
2013-04-15 13:43:20 +05:30
cycle checkCandidateFaceTwins ! try twins in next dimension
2012-06-15 21:40:21 +05:30
endif
endif
enddo
exit checkCandidateFaceTwins
enddo checkCandidateFaceTwins
endif
matchingFace = candidateFace
matchingElem = candidateElem
2013-04-15 13:43:20 +05:30
exit checkCandidate ! found my matching candidate
2012-06-15 21:40:21 +05:30
enddo checkCandidateFace
endif
enddo checkCandidate
2012-05-08 20:27:06 +05:30
2012-06-15 21:40:21 +05:30
end subroutine mesh_faceMatch
2012-05-08 20:27:06 +05:30
2012-04-10 20:45:46 +05:30
2013-04-15 13:43:20 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief get properties of different types of finite elements
!> @details assign globals: FE_nodesAtIP, FE_ipNeighbor, FE_cellnodeParentnodeWeights, FE_subNodeOnIPFace
!--------------------------------------------------------------------------------------------------
2012-06-15 21:40:21 +05:30
subroutine mesh_build_FEdata
2012-04-11 22:58:08 +05:30
implicit none
2012-11-16 04:15:20 +05:30
integer ( pInt ) :: me
2018-09-23 20:56:13 +05:30
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 )
2013-04-15 13:43:20 +05:30
!*** fill FE_nodesAtIP with data ***
2012-11-16 04:15:20 +05:30
me = 0_pInt
me = me + 1_pInt
FE_nodesAtIP ( 1 : FE_maxNnodesAtIP ( me ) , 1 : FE_Nips ( me ) , me ) = & ! element 6 (2D 3node 1ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2012-11-16 04:15:20 +05:30
1 , 2 , 3 &
] , pInt ) , [ FE_maxNnodesAtIP ( me ) , FE_Nips ( me ) ] )
2012-04-20 17:28:41 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
FE_nodesAtIP ( 1 : FE_maxNnodesAtIP ( me ) , 1 : FE_Nips ( me ) , me ) = & ! element 125 (2D 6node 3ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2012-11-16 04:15:20 +05:30
1 , &
2 , &
3 &
] , pInt ) , [ FE_maxNnodesAtIP ( me ) , FE_Nips ( me ) ] )
2012-04-12 00:16:36 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
FE_nodesAtIP ( 1 : FE_maxNnodesAtIP ( me ) , 1 : FE_Nips ( me ) , me ) = & ! element 11 (2D 4node 4ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
1 , &
2 , &
4 , &
3 &
2012-11-16 04:15:20 +05:30
] , pInt ) , [ FE_maxNnodesAtIP ( me ) , FE_Nips ( me ) ] )
2012-04-11 22:58:08 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
FE_nodesAtIP ( 1 : FE_maxNnodesAtIP ( me ) , 1 : FE_Nips ( me ) , me ) = & ! element 27 (2D 8node 9ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
1 , 0 , &
1 , 2 , &
2 , 0 , &
1 , 4 , &
0 , 0 , &
2 , 3 , &
4 , 0 , &
3 , 4 , &
3 , 0 &
2012-11-16 04:15:20 +05:30
] , pInt ) , [ FE_maxNnodesAtIP ( me ) , FE_Nips ( me ) ] )
2012-04-11 22:58:08 +05:30
2012-11-16 04:15:20 +05:30
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)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
1 , &
2 , &
3 , &
4 &
2012-11-16 04:15:20 +05:30
] , pInt ) , [ FE_maxNnodesAtIP ( me ) , FE_Nips ( me ) ] )
2012-04-11 22:58:08 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
FE_nodesAtIP ( 1 : FE_maxNnodesAtIP ( me ) , 1 : FE_Nips ( me ) , me ) = & ! element 136 (3D 6node 6ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
1 , &
2 , &
3 , &
4 , &
5 , &
6 &
2012-11-16 04:15:20 +05:30
] , pInt ) , [ FE_maxNnodesAtIP ( me ) , FE_Nips ( me ) ] )
2012-04-20 17:28:41 +05:30
2012-11-16 04:15:20 +05:30
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)
2012-06-15 21:40:21 +05:30
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 &
2012-11-16 04:15:20 +05:30
] , pInt ) , [ FE_maxNnodesAtIP ( me ) , FE_Nips ( me ) ] )
2012-04-11 22:58:08 +05:30
2018-01-10 21:43:25 +05:30
2012-06-15 21:40:21 +05:30
! *** 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.
2012-11-16 04:15:20 +05:30
me = 0_pInt
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 6 (2D 3node 1ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2012-11-16 04:15:20 +05:30
- 2 , - 3 , - 1 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2018-01-10 21:43:25 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 125 (2D 6node 3ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2012-11-16 04:15:20 +05:30
2 , - 3 , 3 , - 1 , &
- 2 , 1 , 3 , - 1 , &
2 , - 3 , - 2 , 1 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2018-01-10 21:43:25 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 11 (2D 4node 4ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2 , - 4 , 3 , - 1 , &
- 2 , 1 , 4 , - 1 , &
4 , - 4 , - 3 , 1 , &
- 2 , 3 , - 3 , 2 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 27 (2D 8node 9ip)
2012-06-15 21:40:21 +05:30
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 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 134 (3D 4node 1ip)
2012-11-16 04:15:20 +05:30
reshape ( int ( [ &
- 1 , - 2 , - 3 , - 4 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 127 (3D 10node 4ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2 , - 4 , 3 , - 2 , 4 , - 1 , &
2012-11-16 04:15:20 +05:30
- 2 , 1 , 3 , - 2 , 4 , - 1 , &
2 , - 4 , - 3 , 1 , 4 , - 1 , &
2 , - 4 , 3 , - 2 , - 3 , 1 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 136 (3D 6node 6ip)
2012-06-15 21:40:21 +05:30
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 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 117 (3D 8node 1ip)
2012-11-16 04:15:20 +05:30
reshape ( int ( [ &
- 3 , - 5 , - 4 , - 2 , - 6 , - 1 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 7 (3D 8node 8ip)
2012-11-16 04:15:20 +05:30
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 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_ipNeighbor ( 1 : FE_NipNeighbors ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 21 (3D 20node 27ip)
2012-06-15 21:40:21 +05:30
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 &
2013-04-15 13:43:20 +05:30
] , pInt ) , [ FE_NipNeighbors ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2012-06-15 21:40:21 +05:30
2013-04-15 13:43:20 +05:30
! *** FE_cell ***
2012-11-16 04:15:20 +05:30
me = 0_pInt
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
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 ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_cell ( 1 : FE_NcellnodesPerCell ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 125 (2D 6node 3ip)
2012-11-16 04:15:20 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
1 , 4 , 7 , 6 , &
2 , 5 , 7 , 4 , &
3 , 6 , 7 , 5 &
] , pInt ) , [ FE_NcellnodesPerCell ( FE_celltype ( me ) ) , FE_Nips ( me ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_cell ( 1 : FE_NcellnodesPerCell ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 11 (2D 4node 4ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
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 ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_cell ( 1 : FE_NcellnodesPerCell ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 27 (2D 8node 9ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
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 ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
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 ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_cell ( 1 : FE_NcellnodesPerCell ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 127 (3D 10node 4ip)
2012-11-16 04:15:20 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
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 ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_cell ( 1 : FE_NcellnodesPerCell ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 136 (3D 6node 6ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
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 ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
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 ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_cell ( 1 : FE_NcellnodesPerCell ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 7 (3D 8node 8ip)
2012-11-16 04:15:20 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
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 ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_cell ( 1 : FE_NcellnodesPerCell ( FE_celltype ( me ) ) , 1 : FE_Nips ( me ) , me ) = & ! element 21 (3D 20node 27ip)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
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
2012-11-16 04:15:20 +05:30
me = 0_pInt
2013-04-15 13:43:20 +05:30
me = me + 1_pInt
2018-01-10 21:43:25 +05:30
FE_cellnodeParentnodeWeights ( 1 : FE_Nnodes ( me ) , 1 : FE_Ncellnodes ( FE_geomtype ( me ) ) , me ) = & ! element 6 (2D 3node 1ip)
2013-04-15 13:43:20 +05:30
reshape ( real ( [ &
2018-01-10 21:43:25 +05:30
1 , 0 , 0 , &
0 , 1 , 0 , &
2013-04-15 13:43:20 +05:30
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 ( [ &
2018-01-10 21:43:25 +05:30
1 , 0 , 0 , 0 , 0 , 0 , &
0 , 1 , 0 , 0 , 0 , 0 , &
2013-04-15 13:43:20 +05:30
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 ) ) ] )
2018-01-10 21:43:25 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_cellnodeParentnodeWeights ( 1 : FE_Nnodes ( me ) , 1 : FE_Ncellnodes ( FE_geomtype ( me ) ) , me ) = & ! element 11 (2D 4node 4ip)
reshape ( real ( [ &
2018-01-10 21:43:25 +05:30
1 , 0 , 0 , 0 , &
0 , 1 , 0 , 0 , &
2013-04-15 13:43:20 +05:30
0 , 0 , 1 , 0 , &
2018-01-10 21:43:25 +05:30
0 , 0 , 0 , 1 , &
2013-04-15 13:43:20 +05:30
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 ) ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
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 ) ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
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 ) ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2018-01-10 21:43:25 +05:30
FE_cellnodeParentnodeWeights ( 1 : FE_Nnodes ( me ) , 1 : FE_Ncellnodes ( FE_geomtype ( me ) ) , me ) = & ! element 134 (3D 4node 1ip)
2013-04-15 13:43:20 +05:30
reshape ( real ( [ &
2018-01-10 21:43:25 +05:30
1 , 0 , 0 , 0 , &
0 , 1 , 0 , 0 , &
2013-04-15 13:43:20 +05:30
0 , 0 , 1 , 0 , &
2018-01-10 21:43:25 +05:30
0 , 0 , 0 , 1 &
2013-04-15 13:43:20 +05:30
] , pReal ) , [ FE_Nnodes ( me ) , FE_Ncellnodes ( FE_geomtype ( me ) ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2018-01-10 21:43:25 +05:30
FE_cellnodeParentnodeWeights ( 1 : FE_Nnodes ( me ) , 1 : FE_Ncellnodes ( FE_geomtype ( me ) ) , me ) = & ! element 157 (3D 5node 4ip)
2013-04-15 13:43:20 +05:30
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 ) ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
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
2018-01-10 21:43:25 +05:30
FE_cellnodeParentnodeWeights ( 1 : FE_Nnodes ( me ) , 1 : FE_Ncellnodes ( FE_geomtype ( me ) ) , me ) = & ! element 117 (3D 8node 1ip)
2013-04-15 13:43:20 +05:30
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 ( [ &
2018-01-10 21:43:25 +05:30
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 , & !
2013-04-15 13:43:20 +05:30
0 , 0 , 0 , 0 , 1 , 0 , 0 , 0 , & ! 5
2018-01-10 21:43:25 +05:30
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 , & !
2013-04-15 13:43:20 +05:30
0 , 1 , 1 , 0 , 0 , 0 , 0 , 0 , & ! 10
2018-01-10 21:43:25 +05:30
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 , & !
2013-04-15 13:43:20 +05:30
0 , 0 , 1 , 0 , 0 , 0 , 1 , 0 , & ! 15
2018-01-10 21:43:25 +05:30
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 , & !
2013-04-15 13:43:20 +05:30
0 , 0 , 0 , 0 , 1 , 0 , 0 , 1 , & ! 20
2018-01-10 21:43:25 +05:30
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 , & !
2013-04-15 13:43:20 +05:30
1 , 0 , 0 , 1 , 1 , 0 , 0 , 1 , & ! 25
2018-01-10 21:43:25 +05:30
0 , 0 , 0 , 0 , 1 , 1 , 1 , 1 , & !
1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 & !
2013-04-15 13:43:20 +05:30
] , 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 ( [ &
2018-01-10 21:43:25 +05:30
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 & !
2013-04-15 13:43:20 +05:30
] , pReal ) , [ FE_Nnodes ( me ) , FE_Ncellnodes ( FE_geomtype ( me ) ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-15 13:43:20 +05:30
FE_cellnodeParentnodeWeights ( 1 : FE_Nnodes ( me ) , 1 : FE_Ncellnodes ( FE_geomtype ( me ) ) , me ) = & ! element 21 (3D 20node 27ip)
reshape ( real ( [ &
2018-01-10 21:43:25 +05:30
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 & !
2013-04-15 13:43:20 +05:30
] , pReal ) , [ FE_Nnodes ( me ) , FE_Ncellnodes ( FE_geomtype ( me ) ) ] )
! *** FE_cellface ***
me = 0_pInt
me = me + 1_pInt
2013-04-18 22:10:49 +05:30
FE_cellface ( 1 : FE_NcellnodesPerCellface ( me ) , 1 : FE_NipNeighbors ( me ) , me ) = & ! 2D 3node, VTK_TRIANGLE (5)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
2 , 3 , &
3 , 1 , &
1 , 2 &
] , pInt ) , [ FE_NcellnodesPerCellface ( me ) , FE_NipNeighbors ( me ) ] )
2012-06-15 21:40:21 +05:30
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-18 22:10:49 +05:30
FE_cellface ( 1 : FE_NcellnodesPerCellface ( me ) , 1 : FE_NipNeighbors ( me ) , me ) = & ! 2D 4node, VTK_QUAD (9)
2012-11-16 04:15:20 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
2 , 3 , &
4 , 1 , &
3 , 4 , &
1 , 2 &
] , pInt ) , [ FE_NcellnodesPerCellface ( me ) , FE_NipNeighbors ( me ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-18 22:10:49 +05:30
FE_cellface ( 1 : FE_NcellnodesPerCellface ( me ) , 1 : FE_NipNeighbors ( me ) , me ) = & ! 3D 4node, VTK_TETRA (10)
2012-11-16 04:15:20 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
1 , 3 , 2 , &
1 , 2 , 4 , &
2 , 3 , 4 , &
1 , 4 , 3 &
] , pInt ) , [ FE_NcellnodesPerCellface ( me ) , FE_NipNeighbors ( me ) ] )
2012-11-16 04:15:20 +05:30
me = me + 1_pInt
2013-04-18 22:10:49 +05:30
FE_cellface ( 1 : FE_NcellnodesPerCellface ( me ) , 1 : FE_NipNeighbors ( me ) , me ) = & ! 3D 8node, VTK_HEXAHEDRON (12)
2012-06-15 21:40:21 +05:30
reshape ( int ( [ &
2013-04-15 13:43:20 +05:30
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 ) ] )
2012-06-15 21:40:21 +05:30
end subroutine mesh_build_FEdata
2013-04-18 22:10:49 +05:30
2013-04-24 00:00:56 +05:30
!--------------------------------------------------------------------------------------------------
2013-04-29 02:26:17 +05:30
!> @brief returns global variable mesh_Ncellnodes
2013-04-24 00:00:56 +05:30
!--------------------------------------------------------------------------------------------------
integer ( pInt ) function mesh_get_Ncellnodes ( )
implicit none
2018-01-10 21:43:25 +05:30
2013-04-24 00:00:56 +05:30
mesh_get_Ncellnodes = mesh_Ncellnodes
end function mesh_get_Ncellnodes
2013-05-07 18:36:29 +05:30
!--------------------------------------------------------------------------------------------------
!> @brief returns global variable mesh_unitlength
!--------------------------------------------------------------------------------------------------
real ( pReal ) function mesh_get_unitlength ( )
implicit none
2018-01-10 21:43:25 +05:30
2013-05-07 18:36:29 +05:30
mesh_get_unitlength = mesh_unitlength
end function mesh_get_unitlength
2013-04-29 02:26:17 +05:30
!--------------------------------------------------------------------------------------------------
!> @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
2019-01-24 19:49:17 +05:30
elemtype = 10_pInt
2013-04-29 02:26:17 +05:30
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
2012-08-16 20:25:23 +05:30
end module mesh