2011-04-04 19:39:54 +05:30
! Copyright 2011 Max-Planck-Institut f<> r Eisenforschung GmbH
!
! This file is part of DAMASK,
! the D<> sseldorf Advanced MAterial Simulation Kit.
!
! DAMASK is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! DAMASK is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with DAMASK. If not, see <http://www.gnu.org/licenses/>.
!
!##############################################################
2009-08-31 20:39:15 +05:30
!* $Id$
2007-03-20 19:25:22 +05:30
!##############################################################
2007-03-21 21:48:33 +05:30
MODULE mesh
2007-03-20 19:25:22 +05:30
!##############################################################
2007-03-21 21:48:33 +05:30
use prec , only : pReal , pInt
implicit none
! ---------------------------
2007-03-22 20:18:58 +05:30
! _Nelems : total number of elements in mesh
2007-04-25 13:03:24 +05:30
! _NcpElems : total number of CP elements in mesh
2007-03-22 20:18:58 +05:30
! _Nnodes : total number of nodes in mesh
2007-04-04 14:17:34 +05:30
! _maxNnodes : max number of nodes in any CP element
2007-04-25 13:03:24 +05:30
! _maxNips : max number of IPs in any CP element
! _maxNipNeighbors : max number of IP neighbors in any CP element
2007-04-04 14:17:34 +05:30
! _maxNsharedElems : max number of CP elements sharing a node
2007-03-22 20:18:58 +05:30
!
2008-03-25 18:22:27 +05:30
! _element : FEid, type(internal representation), material, texture, node indices
2007-03-26 14:20:57 +05:30
! _node : x,y,z coordinates (initially!)
! _sharedElem : entryCount and list of elements containing node
2007-03-22 20:18:58 +05:30
!
2007-03-27 18:23:31 +05:30
! _mapFEtoCPelem : [sorted FEid, corresponding CPid]
! _mapFEtoCPnode : [sorted FEid, corresponding CPid]
2007-03-22 20:18:58 +05:30
!
! MISSING: these definitions should actually reside in the
! FE-solver specific part (different for MARC/ABAQUS)..!
! Hence, I suggest to prefix with "FE_"
!
2009-04-03 12:33:25 +05:30
! _Nnodes : # nodes in a specific type of element (how we use it)
! _NoriginalNodes : # nodes in a specific type of element (how it is originally defined by marc)
2007-03-26 14:20:57 +05:30
! _Nips : # IPs in a specific type of element
! _NipNeighbors : # IP neighbors in a specific type of element
! _ipNeighbor : +x,-x,+y,-y,+z,-z list of intra-element IPs and
2007-03-22 20:18:58 +05:30
! (negative) neighbor faces per own IP in a specific type of element
2009-01-16 23:06:37 +05:30
! _NfaceNodes : # nodes per face in a specific type of element
2007-03-26 14:20:57 +05:30
! _nodeOnFace : list of node indices on each face of a specific type of element
2010-05-10 20:24:59 +05:30
! _maxNnodesAtIP : max number of (equivalent) nodes attached to an IP
2009-03-30 20:20:19 +05:30
! _nodesAtIP : map IP index to two node indices in a specific type of element
2007-03-26 14:20:57 +05:30
! _ipNeighborhood : 6 or less neighboring IPs as [element_num, IP_index]
2009-01-16 23:06:37 +05:30
! _NsubNodes : # subnodes required to fully define all IP volumes
2007-03-22 20:18:58 +05:30
! order is +x,-x,+y,-y,+z,-z but meaning strongly depends on Elemtype
2007-03-21 21:48:33 +05:30
! ---------------------------
2011-02-16 21:53:08 +05:30
integer ( pInt ) mesh_Nelems , mesh_NcpElems , mesh_NelemSets , mesh_maxNelemInSet
2009-10-12 21:31:49 +05:30
integer ( pInt ) mesh_Nmaterials
2011-02-16 21:53:08 +05:30
integer ( pInt ) mesh_Nnodes , mesh_maxNnodes , mesh_maxNips , mesh_maxNipNeighbors , mesh_maxNsharedElems , mesh_maxNsubNodes
2007-10-24 14:30:42 +05:30
integer ( pInt ) , dimension ( 2 ) :: mesh_maxValStateVar = 0_pInt
2009-10-12 21:31:49 +05:30
character ( len = 64 ) , dimension ( : ) , allocatable :: mesh_nameElemSet , & ! names of elementSet
mesh_nameMaterial , & ! names of material in solid section
mesh_mapMaterial ! name of elementSet for material
integer ( pInt ) , dimension ( : , : ) , allocatable :: mesh_mapElemSet ! list of elements in elementSet
2009-08-11 22:01:57 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable , target :: mesh_mapFEtoCPelem , mesh_mapFEtoCPnode
2011-02-16 21:53:08 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable :: mesh_element , &
mesh_sharedElem , &
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)
2009-01-16 23:06:37 +05:30
integer ( pInt ) , dimension ( : , : , : , : ) , allocatable :: mesh_ipNeighborhood
2009-01-20 00:12:31 +05:30
2009-08-11 22:01:57 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable :: mesh_subNodeCoord ! coordinates of subnodes per element
2011-02-16 21:53:08 +05:30
real ( pReal ) , dimension ( : , : ) , allocatable :: mesh_node , &
mesh_ipVolume ! volume associated with IP
2009-08-11 22:01:57 +05:30
real ( pReal ) , dimension ( : , : , : ) , allocatable :: mesh_ipArea , & ! area of interface to neighboring IP
mesh_ipCenterOfGravity ! center of gravity of IP
real ( pReal ) , dimension ( : , : , : , : ) , allocatable :: mesh_ipAreaNormal ! area normal of interface to neighboring IP
2009-04-06 18:55:19 +05:30
2010-05-10 20:24:59 +05:30
integer ( pInt ) , dimension ( : , : , : ) , allocatable :: FE_nodesAtIP
2009-04-06 18:55:19 +05:30
integer ( pInt ) , dimension ( : , : , : ) , allocatable :: FE_ipNeighbor
integer ( pInt ) , dimension ( : , : , : ) , allocatable :: FE_subNodeParent
integer ( pInt ) , dimension ( : , : , : , : ) , allocatable :: FE_subNodeOnIPFace
2010-07-13 15:56:07 +05:30
logical :: noPart ! for cases where the ABAQUS input file does not use part/assembly information
2011-02-16 21:53:08 +05:30
logical , dimension ( 3 ) :: mesh_periodicSurface ! flag indicating periodic outer surfaces (used for fluxes)
2007-03-21 21:48:33 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) :: hypoelasticTableStyle
integer ( pInt ) :: initialcondTableStyle
2011-04-06 14:05:37 +05:30
integer ( pInt ) , parameter :: FE_Nelemtypes = 10
2009-04-03 12:33:25 +05:30
integer ( pInt ) , parameter :: FE_maxNnodes = 8
2009-04-02 18:30:51 +05:30
integer ( pInt ) , parameter :: FE_maxNsubNodes = 56
integer ( pInt ) , parameter :: FE_maxNips = 27
2009-01-16 23:06:37 +05:30
integer ( pInt ) , parameter :: FE_maxNipNeighbors = 6
2010-05-10 20:24:59 +05:30
integer ( pInt ) , parameter :: FE_maxmaxNnodesAtIP = 8
2009-01-16 20:59:57 +05:30
integer ( pInt ) , parameter :: FE_NipFaceNodes = 4
2007-03-26 14:20:57 +05:30
integer ( pInt ) , dimension ( FE_Nelemtypes ) , parameter :: FE_Nnodes = &
2009-04-03 12:33:25 +05:30
( / 8 , & ! element 7
4 , & ! element 134
4 , & ! element 11
4 , & ! element 27
4 , & ! element 157
6 , & ! element 136
2010-05-10 20:24:59 +05:30
8 , & ! element 21
2010-08-17 04:23:24 +05:30
8 , & ! element 117
2011-04-06 14:05:37 +05:30
8 , & ! element 57 (c3d20r == c3d8 --> copy of 7)
3 & ! element 155, 125, 128
2009-04-03 12:33:25 +05:30
/ )
integer ( pInt ) , dimension ( FE_Nelemtypes ) , parameter :: FE_NoriginalNodes = &
2007-04-25 13:03:24 +05:30
( / 8 , & ! element 7
2007-10-12 19:18:29 +05:30
4 , & ! element 134
4 , & ! element 11
2010-05-10 20:24:59 +05:30
8 , & ! element 27
2008-06-17 14:41:54 +05:30
4 , & ! element 157
2009-04-02 18:30:51 +05:30
6 , & ! element 136
2010-05-10 20:24:59 +05:30
20 , & ! element 21
2010-08-17 04:23:24 +05:30
8 , & ! element 117
2011-04-06 14:05:37 +05:30
20 , & ! element 57 (c3d20r == c3d8 --> copy of 7)
6 & ! element 155, 125, 128
2007-03-28 18:28:51 +05:30
/ )
2007-03-26 14:20:57 +05:30
integer ( pInt ) , dimension ( FE_Nelemtypes ) , parameter :: FE_Nips = &
2007-04-25 13:03:24 +05:30
( / 8 , & ! element 7
2007-10-12 19:18:29 +05:30
1 , & ! element 134
4 , & ! element 11
2008-06-17 14:41:54 +05:30
9 , & ! element 27
4 , & ! element 157
2009-04-02 18:30:51 +05:30
6 , & ! element 136
2010-05-10 20:24:59 +05:30
27 , & ! element 21
2010-08-17 04:23:24 +05:30
1 , & ! element 117
2011-04-06 14:05:37 +05:30
8 , & ! element 57 (c3d20r == c3d8 --> copy of 7)
3 & ! element 155, 125, 128
2007-04-25 13:03:24 +05:30
/ )
2009-01-16 23:06:37 +05:30
integer ( pInt ) , dimension ( FE_Nelemtypes ) , parameter :: FE_NipNeighbors = &
( / 6 , & ! element 7
4 , & ! element 134
4 , & ! element 11
4 , & ! element 27
6 , & ! element 157
2009-04-02 18:30:51 +05:30
6 , & ! element 136
2010-05-10 20:24:59 +05:30
6 , & ! element 21
2010-08-17 04:23:24 +05:30
6 , & ! element 117
2011-04-06 14:05:37 +05:30
6 , & ! element 57 (c3d20r == c3d8 --> copy of 7)
4 & ! element 155, 125, 128
2009-01-16 23:06:37 +05:30
/ )
integer ( pInt ) , dimension ( FE_Nelemtypes ) , parameter :: FE_NsubNodes = &
2009-04-02 18:30:51 +05:30
( / 19 , & ! element 7
2009-01-20 00:12:31 +05:30
0 , & ! element 134
2009-04-02 18:30:51 +05:30
5 , & ! element 11
2009-04-06 18:55:19 +05:30
12 , & ! element 27
2009-01-20 00:12:31 +05:30
0 , & ! element 157
2009-04-06 18:55:19 +05:30
15 , & ! element 136
2010-05-10 20:24:59 +05:30
56 , & ! element 21
2010-08-17 04:23:24 +05:30
0 , & ! element 117
2011-04-06 14:05:37 +05:30
19 , & ! element 57 (c3d20r == c3d8 --> copy of 7)
4 & ! element 155, 125, 128
2009-01-16 23:06:37 +05:30
/ )
2009-01-16 20:59:57 +05:30
integer ( pInt ) , dimension ( FE_maxNipNeighbors , FE_Nelemtypes ) , parameter :: FE_NfaceNodes = &
2007-03-22 20:18:58 +05:30
reshape ( ( / &
2007-04-25 13:03:24 +05:30
4 , 4 , 4 , 4 , 4 , 4 , & ! element 7
2007-10-12 19:18:29 +05:30
3 , 3 , 3 , 3 , 0 , 0 , & ! element 134
2 , 2 , 2 , 2 , 0 , 0 , & ! element 11
2009-04-02 18:30:51 +05:30
2 , 2 , 2 , 2 , 0 , 0 , & ! element 27
2008-06-17 14:41:54 +05:30
3 , 3 , 3 , 3 , 0 , 0 , & ! element 157
2009-04-02 18:30:51 +05:30
3 , 4 , 4 , 4 , 3 , 0 , & ! element 136
2010-05-10 20:24:59 +05:30
4 , 4 , 4 , 4 , 4 , 4 , & ! element 21
2010-08-17 04:23:24 +05:30
4 , 4 , 4 , 4 , 4 , 4 , & ! element 117
2011-04-06 14:05:37 +05:30
4 , 4 , 4 , 4 , 4 , 4 , & ! element 57 (c3d20r == c3d8 --> copy of 7)
2 , 2 , 2 , 0 , 0 , 0 & ! element 155, 125, 128
2009-01-16 20:59:57 +05:30
/ ) , ( / FE_maxNipNeighbors , FE_Nelemtypes / ) )
2010-05-10 20:24:59 +05:30
integer ( pInt ) , dimension ( FE_Nelemtypes ) , parameter :: FE_maxNnodesAtIP = &
( / 1 , & ! element 7
4 , & ! element 134
1 , & ! element 11
2 , & ! element 27
1 , & ! element 157
1 , & ! element 136
4 , & ! element 21
2010-08-17 04:23:24 +05:30
8 , & ! element 117
2011-04-06 14:05:37 +05:30
1 , & ! element 57 (c3d20r == c3d8 --> copy of 7)
1 & ! element 155, 125, 128
2010-05-10 20:24:59 +05:30
/ )
2009-01-16 20:59:57 +05:30
integer ( pInt ) , dimension ( FE_NipFaceNodes , FE_maxNipNeighbors , FE_Nelemtypes ) , parameter :: FE_nodeOnFace = &
2007-03-22 20:18:58 +05:30
reshape ( ( / &
2007-04-25 13:03:24 +05:30
1 , 2 , 3 , 4 , & ! element 7
2 , 1 , 5 , 6 , &
3 , 2 , 6 , 7 , &
2008-06-17 14:41:54 +05:30
4 , 3 , 7 , 8 , &
2007-04-25 13:03:24 +05:30
4 , 1 , 5 , 8 , &
8 , 7 , 6 , 5 , &
1 , 2 , 3 , 0 , & ! element 134
1 , 4 , 2 , 0 , &
2 , 3 , 4 , 0 , &
1 , 3 , 4 , 0 , &
0 , 0 , 0 , 0 , &
2007-10-12 19:18:29 +05:30
0 , 0 , 0 , 0 , &
1 , 2 , 0 , 0 , & ! element 11
2 , 3 , 0 , 0 , &
3 , 4 , 0 , 0 , &
4 , 1 , 0 , 0 , &
0 , 0 , 0 , 0 , &
0 , 0 , 0 , 0 , &
2009-04-02 18:30:51 +05:30
1 , 2 , 0 , 0 , & ! element 27
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 , &
1 , 2 , 3 , 0 , & ! element 157
1 , 4 , 2 , 0 , &
2 , 3 , 4 , 0 , &
1 , 3 , 4 , 0 , &
0 , 0 , 0 , 0 , &
0 , 0 , 0 , 0 , &
1 , 2 , 3 , 0 , & ! element 136
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 , &
1 , 2 , 3 , 4 , & ! element 21
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 , &
1 , 2 , 3 , 4 , & ! element 117
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 , &
1 , 2 , 3 , 4 , & ! element 57 (c3d20r == c3d8 --> copy of 7)
2 , 1 , 5 , 6 , &
3 , 2 , 6 , 7 , &
4 , 3 , 7 , 8 , &
4 , 1 , 5 , 8 , &
2011-04-06 14:05:37 +05:30
8 , 7 , 6 , 5 , &
1 , 2 , 0 , 0 , & ! element 155,125,128
2 , 3 , 0 , 0 , &
3 , 1 , 0 , 0 , &
0 , 0 , 0 , 0 , &
0 , 0 , 0 , 0 , &
0 , 0 , 0 , 0 &
2009-01-16 20:59:57 +05:30
/ ) , ( / FE_NipFaceNodes , FE_maxNipNeighbors , FE_Nelemtypes / ) )
2009-04-06 18:55:19 +05:30
2007-03-21 21:48:33 +05:30
CONTAINS
! ---------------------------
! subroutine mesh_init()
! function mesh_FEtoCPelement(FEid)
2007-03-26 14:20:57 +05:30
! function mesh_build_ipNeighorhood()
2007-03-21 21:48:33 +05:30
! ---------------------------
2009-01-20 00:12:31 +05:30
2007-04-25 13:03:24 +05:30
!***********************************************************
! initialization
!***********************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_init ( ip , element )
2009-01-20 00:12:31 +05:30
2010-05-11 12:27:15 +05:30
use mpie_interface
2007-04-10 16:52:53 +05:30
use prec , only : pInt
2010-07-13 15:56:07 +05:30
use IO , only : IO_error , IO_open_InputFile , IO_abaqus_hasNoPart
2009-10-12 21:31:49 +05:30
use FEsolving , only : parallelExecution , FEsolving_execElem , FEsolving_execIP , calcMode , lastMode
2009-03-04 17:18:54 +05:30
2007-04-10 16:52:53 +05:30
implicit none
integer ( pInt ) , parameter :: fileUnit = 222
2009-10-12 21:31:49 +05:30
integer ( pInt ) e , element , ip
2009-06-18 19:58:02 +05:30
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
!$OMP CRITICAL (write2out)
2011-03-21 16:01:17 +05:30
write ( 6 , * )
write ( 6 , * ) '<<<+- mesh init -+>>>'
write ( 6 , * ) '$Id$'
write ( 6 , * )
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
!$OMP END CRITICAL (write2out)
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
call mesh_build_FEdata ( ) ! --- get properties of the different types of elements
if ( IO_open_inputFile ( fileUnit ) ) then ! --- parse info from input file...
select case ( FEsolver )
2010-05-06 22:10:47 +05:30
case ( 'Spectral' )
call mesh_spectral_count_nodesAndElements ( fileUnit )
call mesh_spectral_count_cpElements ( )
call mesh_spectral_map_elements ( )
call mesh_spectral_map_nodes ( )
call mesh_spectral_count_cpSizes ( )
call mesh_spectral_build_nodes ( fileUnit )
call mesh_spectral_build_elements ( fileUnit )
2009-10-12 21:31:49 +05:30
case ( 'Marc' )
call mesh_marc_get_tableStyles ( fileUnit )
call mesh_marc_count_nodesAndElements ( fileUnit )
call mesh_marc_count_elementSets ( fileUnit )
call mesh_marc_map_elementSets ( fileUnit )
call mesh_marc_count_cpElements ( fileUnit )
call mesh_marc_map_elements ( fileUnit )
call mesh_marc_map_nodes ( fileUnit )
call mesh_marc_build_nodes ( fileUnit )
call mesh_marc_count_cpSizes ( fileunit )
call mesh_marc_build_elements ( fileUnit )
2011-02-16 21:53:08 +05:30
call mesh_marc_get_mpieOptions ( fileUnit )
2009-10-12 21:31:49 +05:30
case ( 'Abaqus' )
2010-07-13 15:56:07 +05:30
noPart = IO_abaqus_hasNoPart ( fileUnit )
2009-10-12 21:31:49 +05:30
call mesh_abaqus_count_nodesAndElements ( fileUnit )
call mesh_abaqus_count_elementSets ( fileUnit )
call mesh_abaqus_count_materials ( fileUnit )
call mesh_abaqus_map_elementSets ( fileUnit )
call mesh_abaqus_map_materials ( fileUnit )
call mesh_abaqus_count_cpElements ( fileUnit )
call mesh_abaqus_map_elements ( fileUnit )
call mesh_abaqus_map_nodes ( fileUnit )
call mesh_abaqus_build_nodes ( fileUnit )
call mesh_abaqus_count_cpSizes ( fileunit )
call mesh_abaqus_build_elements ( fileUnit )
end select
close ( fileUnit )
2009-01-16 23:06:37 +05:30
call mesh_build_subNodeCoords ( )
call mesh_build_ipVolumes ( )
call mesh_build_ipAreas ( )
2011-02-16 21:53:08 +05:30
call mesh_build_nodeTwins ( )
call mesh_build_sharedElems ( )
call mesh_build_ipNeighborhood ( )
2007-10-24 14:30:42 +05:30
call mesh_tell_statistics ( )
2010-07-13 15:56:07 +05:30
2010-03-24 18:50:12 +05:30
parallelExecution = ( parallelExecution . and . ( mesh_Nelems == mesh_NcpElems ) ) ! plus potential killer from non-local constitutive
2007-04-10 16:52:53 +05:30
else
2010-02-18 13:59:57 +05:30
call IO_error ( 101 ) ! cannot open input file
2007-04-10 16:52:53 +05:30
endif
2009-06-15 18:41:21 +05:30
FEsolving_execElem = ( / 1 , mesh_NcpElems / )
allocate ( FEsolving_execIP ( 2 , mesh_NcpElems ) ) ; FEsolving_execIP = 1_pInt
forall ( e = 1 : mesh_NcpElems ) FEsolving_execIP ( 2 , e ) = FE_Nips ( mesh_element ( 2 , e ) )
2009-10-12 21:31:49 +05:30
allocate ( calcMode ( mesh_maxNips , mesh_NcpElems ) )
calcMode = . false . ! pretend to have collected what first call is asking (F = I)
calcMode ( ip , mesh_FEasCP ( 'elem' , element ) ) = . true . ! first ip,el needs to be already pingponged to "calc"
lastMode = . true . ! and its mode is already known...
2009-06-15 18:41:21 +05:30
endsubroutine
2007-03-26 14:20:57 +05:30
2007-04-10 16:52:53 +05:30
2009-01-20 00:12:31 +05:30
2008-06-17 02:19:48 +05:30
!***********************************************************
! mapping of FE element types to internal representation
!***********************************************************
2009-06-15 18:41:21 +05:30
function FE_mapElemtype ( what )
2010-07-13 15:56:07 +05:30
use IO , only : IO_lc
2009-01-20 00:12:31 +05:30
2008-06-17 02:19:48 +05:30
implicit none
character ( len = * ) , intent ( in ) :: what
integer ( pInt ) FE_mapElemtype
2010-07-13 15:56:07 +05:30
select case ( IO_lc ( what ) )
2010-05-10 20:24:59 +05:30
case ( '7' , &
2010-07-13 15:56:07 +05:30
'c3d8' )
2009-10-12 21:31:49 +05:30
FE_mapElemtype = 1 ! Three-dimensional Arbitrarily Distorted Brick
2010-05-10 20:24:59 +05:30
case ( '134' , &
2010-07-13 15:56:07 +05:30
'c3d4' )
2009-10-12 21:31:49 +05:30
FE_mapElemtype = 2 ! Three-dimensional Four-node Tetrahedron
2010-05-10 20:24:59 +05:30
case ( '11' , &
2010-07-13 15:56:07 +05:30
'cpe4' )
2009-10-12 21:31:49 +05:30
FE_mapElemtype = 3 ! Arbitrary Quadrilateral Plane-strain
2010-05-10 20:24:59 +05:30
case ( '27' , &
2010-07-13 15:56:07 +05:30
'cpe8' )
2009-10-12 21:31:49 +05:30
FE_mapElemtype = 4 ! Plane Strain, Eight-node Distorted Quadrilateral
2008-06-17 14:41:54 +05:30
case ( '157' )
2009-10-12 21:31:49 +05:30
FE_mapElemtype = 5 ! Three-dimensional, Low-order, Tetrahedron, Herrmann Formulations
2010-05-10 20:24:59 +05:30
case ( '136' , &
2010-07-13 15:56:07 +05:30
'c3d6' )
2009-10-12 21:31:49 +05:30
FE_mapElemtype = 6 ! Three-dimensional Arbitrarily Distorted Pentahedral
2010-05-10 20:24:59 +05:30
case ( '21' , &
2010-07-13 15:56:07 +05:30
'c3d20' )
2010-05-10 20:24:59 +05:30
FE_mapElemtype = 7 ! Three-dimensional Arbitrarily Distorted quadratic hexahedral
case ( '117' , &
'123' , &
2010-07-13 15:56:07 +05:30
'c3d8r' )
2010-05-10 20:24:59 +05:30
FE_mapElemtype = 8 ! Three-dimensional Arbitrarily Distorted linear hexahedral with reduced integration
2010-08-17 04:23:24 +05:30
case ( '57' , &
'c3d20r' )
FE_mapElemtype = 9 ! Three-dimensional Arbitrarily Distorted quad hexahedral with reduced integration
2011-04-06 14:05:37 +05:30
case ( '155' , &
'125' , &
'128' )
FE_mapElemtype = 10 ! Two-dimensional Plane Strain triangle (155: cubic shape function, 125/128: second order isoparametric)
2009-10-12 21:31:49 +05:30
case default
FE_mapElemtype = 0 ! unknown element --> should raise an error upstream..!
2009-06-15 18:41:21 +05:30
endselect
2009-01-20 00:12:31 +05:30
2009-06-15 18:41:21 +05:30
endfunction
2008-06-17 02:19:48 +05:30
2009-01-20 00:12:31 +05:30
2007-03-26 14:20:57 +05:30
!***********************************************************
2007-04-10 16:52:53 +05:30
! FE to CP id mapping by binary search thru lookup array
2007-03-26 14:20:57 +05:30
!
2007-04-10 16:52:53 +05:30
! valid questions are 'elem', 'node'
!***********************************************************
2009-06-15 18:41:21 +05:30
function mesh_FEasCP ( what , id )
2007-04-10 16:52:53 +05:30
use prec , only : pInt
use IO , only : IO_lc
implicit none
character ( len = * ) , intent ( in ) :: what
integer ( pInt ) , intent ( in ) :: id
integer ( pInt ) , dimension ( : , : ) , pointer :: lookupMap
integer ( pInt ) mesh_FEasCP , lower , upper , center
mesh_FEasCP = 0_pInt
select case ( IO_lc ( what ( 1 : 4 ) ) )
case ( 'elem' )
lookupMap = > mesh_mapFEtoCPelem
case ( 'node' )
lookupMap = > mesh_mapFEtoCPnode
case default
return
2009-06-15 18:41:21 +05:30
endselect
2007-04-10 16:52:53 +05:30
lower = 1_pInt
upper = size ( lookupMap , 2 )
! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds?
if ( lookupMap ( 1 , lower ) == id ) then
mesh_FEasCP = lookupMap ( 2 , lower )
return
elseif ( lookupMap ( 1 , upper ) == id ) then
mesh_FEasCP = lookupMap ( 2 , upper )
return
endif
! binary search in between bounds
do while ( upper - lower > 1 )
center = ( lower + upper ) / 2
if ( lookupMap ( 1 , center ) < id ) then
lower = center
elseif ( lookupMap ( 1 , center ) > id ) then
upper = center
else
mesh_FEasCP = lookupMap ( 2 , center )
exit
2009-06-15 18:41:21 +05:30
endif
enddo
2007-04-10 16:52:53 +05:30
return
2009-06-15 18:41:21 +05:30
endfunction
2007-04-10 16:52:53 +05:30
2009-01-20 00:12:31 +05:30
2007-03-26 14:20:57 +05:30
!***********************************************************
2007-04-10 16:52:53 +05:30
! find face-matching element of same type
2009-10-12 21:31:49 +05:30
!***********************************************************
2011-02-16 21:53:08 +05:30
subroutine mesh_faceMatch ( elem , face , matchingElem , matchingFace )
use prec , only : pInt
implicit none
!*** output variables
integer ( pInt ) , intent ( out ) :: matchingElem , & ! matching CP element ID
matchingFace ! matching FE face ID
!*** input variables
integer ( pInt ) , intent ( in ) :: face , & ! FE face ID
elem ! FE elem ID
!*** local variables
integer ( pInt ) , dimension ( FE_NfaceNodes ( face , mesh_element ( 2 , elem ) ) ) :: &
myFaceNodes ! global node ids on my face
integer ( pInt ) myType , &
candidateType , &
candidateElem , &
candidateFace , &
candidateFaceNode , &
minNsharedElems , &
NsharedElems , &
lonelyNode , &
i , &
n , &
dir ! periodicity direction
integer ( pInt ) , dimension ( : ) , allocatable :: element_seen
logical checkTwins
minNsharedElems = mesh_maxNsharedElems + 1_pInt ! init to worst case
matchingFace = 0_pInt
matchingElem = 0_pInt ! intialize to "no match found"
myType = mesh_element ( 2 , elem ) ! figure elemType
do n = 1 , FE_NfaceNodes ( face , myType ) ! loop over nodes on face
myFaceNodes ( n ) = mesh_FEasCP ( 'node' , mesh_element ( 4 + FE_nodeOnFace ( n , face , myType ) , elem ) ) ! CP id of face node
NsharedElems = mesh_sharedElem ( 1 , myFaceNodes ( n ) ) ! figure # shared elements for this node
if ( NsharedElems < minNsharedElems ) then
minNsharedElems = NsharedElems ! remember min # shared elems
lonelyNode = n ! remember most lonely node
endif
enddo
allocate ( element_seen ( minNsharedElems ) )
element_seen = 0_pInt
checkCandidate : do i = 1 , minNsharedElems ! iterate over lonelyNode's shared elements
candidateElem = mesh_sharedElem ( 1 + i , myFaceNodes ( lonelyNode ) ) ! present candidate elem
if ( all ( element_seen / = candidateElem ) ) then ! element seen for the first time?
element_seen ( i ) = candidateElem
candidateType = mesh_element ( 2 , candidateElem ) ! figure elemType of candidate
checkCandidateFace : do candidateFace = 1 , FE_maxNipNeighbors ! check each face of candidate
if ( FE_NfaceNodes ( candidateFace , candidateType ) / = FE_NfaceNodes ( face , myType ) & ! incompatible face
. or . ( candidateElem == elem . and . candidateFace == face ) ) then ! this is my face
cycle checkCandidateFace
endif
checkTwins = . false .
do n = 1 , FE_NfaceNodes ( candidateFace , candidateType ) ! loop through nodes on face
candidateFaceNode = mesh_FEasCP ( 'node' , mesh_element ( 4 + FE_nodeOnFace ( n , candidateFace , candidateType ) , candidateElem ) )
if ( all ( myFaceNodes / = candidateFaceNode ) ) then ! candidate node does not match any of my face nodes
checkTwins = . true . ! perhaps the twin nodes do match
exit
endif
enddo
if ( checkTwins ) then
checkCandidateFaceTwins : do dir = 1 , 3
do n = 1 , FE_NfaceNodes ( candidateFace , candidateType ) ! loop through nodes on face
candidateFaceNode = mesh_FEasCP ( 'node' , mesh_element ( 4 + FE_nodeOnFace ( n , candidateFace , candidateType ) , candidateElem ) )
if ( all ( myFaceNodes / = mesh_nodeTwins ( dir , candidateFaceNode ) ) ) then ! node twin does not match either
if ( dir == 3 ) then
cycle checkCandidateFace
else
cycle checkCandidateFaceTwins ! try twins in next dimension
endif
endif
enddo
exit checkCandidateFaceTwins
enddo checkCandidateFaceTwins
endif
matchingFace = candidateFace
matchingElem = candidateElem
exit checkCandidate ! found my matching candidate
enddo checkCandidateFace
endif
enddo checkCandidate
deallocate ( element_seen )
endsubroutine
2007-03-26 14:20:57 +05:30
2009-04-06 18:55:19 +05:30
!********************************************************************
! get properties of different types of finite elements
!
! assign globals:
! FE_nodesAtIP, FE_ipNeighbor, FE_subNodeParent, FE_subNodeOnIPFace
!********************************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_build_FEdata ( )
2009-04-06 18:55:19 +05:30
use prec , only : pInt
implicit none
2010-05-10 20:24:59 +05:30
allocate ( FE_nodesAtIP ( FE_maxmaxNnodesAtIP , FE_maxNips , FE_Nelemtypes ) ) ; FE_nodesAtIP = 0_pInt
2009-04-06 18:55:19 +05:30
allocate ( FE_ipNeighbor ( FE_maxNipNeighbors , FE_maxNips , FE_Nelemtypes ) ) ; FE_ipNeighbor = 0_pInt
allocate ( FE_subNodeParent ( FE_maxNips , FE_maxNsubNodes , FE_Nelemtypes ) ) ; FE_subNodeParent = 0_pInt
allocate ( FE_subNodeOnIPFace ( FE_NipFaceNodes , FE_maxNipNeighbors , FE_maxNips , FE_Nelemtypes ) ) ; FE_subNodeOnIPFace = 0_pInt
! fill FE_nodesAtIP with data
2010-05-10 20:24:59 +05:30
FE_nodesAtIP ( : , : FE_Nips ( 1 ) , 1 ) = & ! element 7
2009-04-06 18:55:19 +05:30
reshape ( ( / &
2010-05-10 20:24:59 +05:30
1 , &
2 , &
4 , &
3 , &
5 , &
6 , &
8 , &
7 &
/ ) , ( / FE_maxNnodesAtIP ( 1 ) , FE_Nips ( 1 ) / ) )
FE_nodesAtIP ( : , : FE_Nips ( 2 ) , 2 ) = & ! element 134
2009-04-06 18:55:19 +05:30
reshape ( ( / &
2010-05-10 20:24:59 +05:30
1 , 2 , 3 , 4 &
/ ) , ( / FE_maxNnodesAtIP ( 2 ) , FE_Nips ( 2 ) / ) )
FE_nodesAtIP ( : , : FE_Nips ( 3 ) , 3 ) = & ! element 11
2009-04-06 18:55:19 +05:30
reshape ( ( / &
2010-05-10 20:24:59 +05:30
1 , &
2 , &
4 , &
3 &
/ ) , ( / FE_maxNnodesAtIP ( 3 ) , FE_Nips ( 3 ) / ) )
FE_nodesAtIP ( : , : FE_Nips ( 4 ) , 4 ) = & ! element 27
2009-04-06 18:55:19 +05:30
reshape ( ( / &
2010-05-10 20:24:59 +05:30
1 , 0 , &
1 , 2 , &
2 , 0 , &
1 , 4 , &
0 , 0 , &
2 , 3 , &
4 , 0 , &
3 , 4 , &
3 , 0 &
/ ) , ( / FE_maxNnodesAtIP ( 4 ) , FE_Nips ( 4 ) / ) )
FE_nodesAtIP ( : , : FE_Nips ( 5 ) , 5 ) = & ! element 157
2009-04-06 18:55:19 +05:30
reshape ( ( / &
2010-05-10 20:24:59 +05:30
1 , &
2 , &
3 , &
4 &
/ ) , ( / FE_maxNnodesAtIP ( 5 ) , FE_Nips ( 5 ) / ) )
FE_nodesAtIP ( : , : FE_Nips ( 6 ) , 6 ) = & ! element 136
2009-04-06 18:55:19 +05:30
reshape ( ( / &
2010-05-10 20:24:59 +05:30
1 , &
2 , &
3 , &
4 , &
5 , &
6 &
/ ) , ( / FE_maxNnodesAtIP ( 6 ) , FE_Nips ( 6 ) / ) )
2010-08-17 04:23:24 +05:30
FE_nodesAtIP ( : , : FE_Nips ( 7 ) , 7 ) = & ! element 21
2009-04-06 18:55:19 +05:30
reshape ( ( / &
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 &
2010-05-10 20:24:59 +05:30
/ ) , ( / FE_maxNnodesAtIP ( 7 ) , FE_Nips ( 7 ) / ) )
2011-02-16 21:53:08 +05:30
! FE_nodesAtIP(:,:FE_Nips(8),8) = & ! element 117 (c3d8r --> single IP per element, so no need for this mapping)
! reshape((/&
! 1,2,3,4,5,6,7,8 &
! /),(/FE_maxNnodesAtIP(8),FE_Nips(8)/))
2010-08-17 04:23:24 +05:30
FE_nodesAtIP ( : , : FE_Nips ( 9 ) , 9 ) = & ! element 57 (c3d20r == c3d8 --> copy of 7)
reshape ( ( / &
1 , &
2 , &
4 , &
3 , &
5 , &
6 , &
8 , &
7 &
/ ) , ( / FE_maxNnodesAtIP ( 9 ) , FE_Nips ( 9 ) / ) )
2011-04-06 14:05:37 +05:30
FE_nodesAtIP ( : , : FE_Nips ( 10 ) , 10 ) = & ! element 155, 125, 128
reshape ( ( / &
1 , &
2 , &
3 &
/ ) , ( / FE_maxNnodesAtIP ( 10 ) , FE_Nips ( 10 ) / ) )
2009-04-06 18:55:19 +05:30
2011-04-06 14:05:37 +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.
2009-04-06 18:55:19 +05:30
FE_ipNeighbor ( : FE_NipNeighbors ( 1 ) , : FE_Nips ( 1 ) , 1 ) = & ! element 7
reshape ( ( / &
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 &
/ ) , ( / FE_NipNeighbors ( 1 ) , FE_Nips ( 1 ) / ) )
FE_ipNeighbor ( : FE_NipNeighbors ( 2 ) , : FE_Nips ( 2 ) , 2 ) = & ! element 134
reshape ( ( / &
- 1 , - 2 , - 3 , - 4 &
/ ) , ( / FE_NipNeighbors ( 2 ) , FE_Nips ( 2 ) / ) )
FE_ipNeighbor ( : FE_NipNeighbors ( 3 ) , : FE_Nips ( 3 ) , 3 ) = & ! element 11
reshape ( ( / &
2 , - 4 , 3 , - 1 , &
- 2 , 1 , 4 , - 1 , &
4 , - 4 , - 3 , 1 , &
- 2 , 3 , - 3 , 2 &
/ ) , ( / FE_NipNeighbors ( 3 ) , FE_Nips ( 3 ) / ) )
FE_ipNeighbor ( : FE_NipNeighbors ( 4 ) , : FE_Nips ( 4 ) , 4 ) = & ! element 27
reshape ( ( / &
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 &
/ ) , ( / FE_NipNeighbors ( 4 ) , FE_Nips ( 4 ) / ) )
FE_ipNeighbor ( : FE_NipNeighbors ( 5 ) , : FE_Nips ( 5 ) , 5 ) = & ! element 157
reshape ( ( / &
2 , - 4 , 3 , - 2 , 4 , - 1 , &
3 , - 2 , 1 , - 3 , 4 , - 1 , &
1 , - 3 , 2 , - 4 , 4 , - 1 , &
1 , - 3 , 2 , - 4 , 3 , - 2 &
/ ) , ( / FE_NipNeighbors ( 5 ) , FE_Nips ( 5 ) / ) )
FE_ipNeighbor ( : FE_NipNeighbors ( 6 ) , : FE_Nips ( 6 ) , 6 ) = & ! element 136
reshape ( ( / &
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 &
/ ) , ( / FE_NipNeighbors ( 6 ) , FE_Nips ( 6 ) / ) )
FE_ipNeighbor ( : FE_NipNeighbors ( 7 ) , : FE_Nips ( 7 ) , 7 ) = & ! element 21
reshape ( ( / &
2010-04-06 17:15:23 +05:30
2 , - 5 , 4 , - 2 , 10 , - 1 , &
2009-04-06 18:55:19 +05:30
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 , &
2010-04-06 17:15:23 +05:30
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 , &
2009-04-06 18:55:19 +05:30
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 &
/ ) , ( / FE_NipNeighbors ( 7 ) , FE_Nips ( 7 ) / ) )
2010-05-10 20:24:59 +05:30
FE_ipNeighbor ( : FE_NipNeighbors ( 8 ) , : FE_Nips ( 8 ) , 8 ) = & ! element 117
reshape ( ( / &
- 3 , - 5 , - 4 , - 2 , - 6 , - 1 &
/ ) , ( / FE_NipNeighbors ( 8 ) , FE_Nips ( 8 ) / ) )
2010-08-17 04:23:24 +05:30
FE_ipNeighbor ( : FE_NipNeighbors ( 9 ) , : FE_Nips ( 9 ) , 9 ) = & ! element 57 (c3d20r == c3d8 --> copy of 7)
reshape ( ( / &
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 &
/ ) , ( / FE_NipNeighbors ( 9 ) , FE_Nips ( 9 ) / ) )
2011-04-06 14:05:37 +05:30
FE_ipNeighbor ( : FE_NipNeighbors ( 10 ) , : FE_Nips ( 10 ) , 10 ) = & ! element 155, 125, 128
reshape ( ( / &
2 , - 3 , 3 , - 1 , &
- 2 , 1 , 3 , - 1 , &
2 , - 3 , - 2 , 1 &
/ ) , ( / FE_NipNeighbors ( 10 ) , FE_Nips ( 10 ) / ) )
! *** FE_subNodeParent ***
! lists the group of IPs for which the center of gravity
! corresponds to the location of a each subnode.
! example: face-centered subnode with faceNodes 1,2,3,4 to be used in,
! e.g., a 8 IP grid, would be encoded:
! 1, 2, 3, 4, 0, 0, 0, 0
2009-04-06 18:55:19 +05:30
FE_subNodeParent ( : FE_Nips ( 1 ) , : FE_NsubNodes ( 1 ) , 1 ) = & ! element 7
reshape ( ( / &
1 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , &
1 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , &
5 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , &
6 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , &
7 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , &
8 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , &
1 , 2 , 3 , 4 , 0 , 0 , 0 , 0 , &
1 , 2 , 6 , 5 , 0 , 0 , 0 , 0 , &
2 , 3 , 7 , 6 , 0 , 0 , 0 , 0 , &
3 , 4 , 8 , 7 , 0 , 0 , 0 , 0 , &
1 , 4 , 8 , 5 , 0 , 0 , 0 , 0 , &
5 , 6 , 7 , 8 , 0 , 0 , 0 , 0 , &
1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 &
/ ) , ( / FE_Nips ( 1 ) , FE_NsubNodes ( 1 ) / ) )
2010-05-10 20:24:59 +05:30
!FE_subNodeParent(:FE_Nips(2),:FE_NsubNodes(2),2) ! element 134 has no subnodes
2009-04-06 18:55:19 +05:30
FE_subNodeParent ( : FE_Nips ( 3 ) , : FE_NsubNodes ( 3 ) , 3 ) = & ! element 11
reshape ( ( / &
1 , 2 , 0 , 0 , &
2 , 3 , 0 , 0 , &
3 , 4 , 0 , 0 , &
4 , 1 , 0 , 0 , &
1 , 2 , 3 , 4 &
/ ) , ( / FE_Nips ( 3 ) , FE_NsubNodes ( 3 ) / ) )
FE_subNodeParent ( : FE_Nips ( 4 ) , : FE_NsubNodes ( 4 ) , 4 ) = & ! element 27
reshape ( ( / &
1 , 1 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , &
1 , 2 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 2 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 3 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 3 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 4 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 4 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 1 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , &
1 , 1 , 1 , 1 , 2 , 2 , 4 , 4 , 3 , &
2 , 2 , 2 , 2 , 1 , 1 , 3 , 3 , 4 , &
3 , 3 , 3 , 3 , 2 , 2 , 4 , 4 , 1 , &
4 , 4 , 4 , 4 , 1 , 1 , 3 , 3 , 2 &
/ ) , ( / FE_Nips ( 4 ) , FE_NsubNodes ( 4 ) / ) )
!FE_subNodeParent(:FE_Nips(5),:FE_NsubNodes(5),5) = & ! element 157
! reshape((/&
! *still to be defined*
! /),(/FE_Nips(5),FE_NsubNodes(5)/))
FE_subNodeParent ( : FE_Nips ( 6 ) , : FE_NsubNodes ( 6 ) , 6 ) = & ! element 136
reshape ( ( / &
1 , 2 , 0 , 0 , 0 , 0 , &
2 , 3 , 0 , 0 , 0 , 0 , &
3 , 1 , 0 , 0 , 0 , 0 , &
1 , 4 , 0 , 0 , 0 , 0 , &
2 , 5 , 0 , 0 , 0 , 0 , &
3 , 6 , 0 , 0 , 0 , 0 , &
4 , 5 , 0 , 0 , 0 , 0 , &
5 , 6 , 0 , 0 , 0 , 0 , &
6 , 4 , 0 , 0 , 0 , 0 , &
1 , 2 , 3 , 0 , 0 , 0 , &
1 , 2 , 4 , 5 , 0 , 0 , &
2 , 3 , 5 , 6 , 0 , 0 , &
1 , 3 , 4 , 6 , 0 , 0 , &
4 , 5 , 6 , 0 , 0 , 0 , &
1 , 2 , 3 , 4 , 5 , 6 &
/ ) , ( / FE_Nips ( 6 ) , FE_NsubNodes ( 6 ) / ) )
FE_subNodeParent ( : FE_Nips ( 7 ) , : FE_NsubNodes ( 7 ) , 7 ) = & ! element 21
reshape ( ( / &
1 , 1 , 2 , 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 , 2 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 2 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 3 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 3 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 4 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 4 , 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 , &
4 , 1 , 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 , 1 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 2 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 3 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 4 , 8 , 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 , 5 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 6 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 7 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 8 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
5 , 5 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
5 , 6 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
6 , 6 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
6 , 7 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
7 , 7 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
7 , 8 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
8 , 8 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
8 , 5 , 5 , 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 , 1 , 1 , 1 , 2 , 2 , 4 , 4 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 2 , 2 , 2 , 1 , 1 , 3 , 3 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 3 , 3 , 3 , 2 , 2 , 4 , 4 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 4 , 4 , 4 , 1 , 1 , 3 , 3 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
1 , 1 , 1 , 1 , 2 , 2 , 5 , 5 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 2 , 2 , 2 , 1 , 1 , 6 , 6 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 2 , 2 , 2 , 3 , 3 , 6 , 6 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 3 , 3 , 3 , 2 , 2 , 7 , 7 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 3 , 3 , 3 , 4 , 4 , 7 , 7 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 4 , 4 , 4 , 3 , 3 , 8 , 8 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 4 , 4 , 4 , 1 , 1 , 8 , 8 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
1 , 1 , 1 , 1 , 4 , 4 , 5 , 5 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
5 , 5 , 5 , 5 , 1 , 1 , 6 , 6 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
6 , 6 , 6 , 6 , 2 , 2 , 5 , 5 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
6 , 6 , 6 , 6 , 2 , 2 , 7 , 7 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
7 , 7 , 7 , 7 , 3 , 3 , 6 , 6 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
7 , 7 , 7 , 7 , 3 , 3 , 8 , 8 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
8 , 8 , 8 , 8 , 4 , 4 , 7 , 7 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
8 , 8 , 8 , 8 , 4 , 4 , 5 , 5 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
5 , 5 , 5 , 5 , 1 , 1 , 8 , 8 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
5 , 5 , 5 , 5 , 6 , 6 , 8 , 8 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
6 , 6 , 6 , 6 , 5 , 5 , 7 , 7 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
7 , 7 , 7 , 7 , 6 , 6 , 8 , 8 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
8 , 8 , 8 , 8 , 5 , 5 , 7 , 7 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , &
1 , 1 , 1 , 1 , 1 , 1 , 1 , 1 , 2 , 2 , 2 , 2 , 4 , 4 , 4 , 4 , 5 , 5 , 5 , 5 , 3 , 3 , 6 , 6 , 8 , 8 , 7 , &
2 , 2 , 2 , 2 , 2 , 2 , 2 , 2 , 1 , 1 , 1 , 1 , 3 , 3 , 3 , 3 , 6 , 6 , 6 , 6 , 4 , 4 , 5 , 5 , 7 , 7 , 8 , &
3 , 3 , 3 , 3 , 3 , 3 , 3 , 3 , 2 , 2 , 2 , 2 , 4 , 4 , 4 , 4 , 7 , 7 , 7 , 7 , 1 , 1 , 6 , 6 , 8 , 8 , 5 , &
4 , 4 , 4 , 4 , 4 , 4 , 4 , 4 , 1 , 1 , 1 , 1 , 3 , 3 , 3 , 3 , 8 , 8 , 8 , 8 , 2 , 2 , 5 , 5 , 7 , 7 , 6 , &
5 , 5 , 5 , 5 , 5 , 5 , 5 , 5 , 1 , 1 , 1 , 1 , 6 , 6 , 6 , 6 , 8 , 8 , 8 , 8 , 2 , 2 , 4 , 4 , 7 , 7 , 3 , &
6 , 6 , 6 , 6 , 6 , 6 , 6 , 6 , 2 , 2 , 2 , 2 , 5 , 5 , 5 , 5 , 7 , 7 , 7 , 7 , 1 , 1 , 3 , 3 , 8 , 8 , 4 , &
7 , 7 , 7 , 7 , 7 , 7 , 7 , 7 , 3 , 3 , 3 , 3 , 6 , 6 , 6 , 6 , 8 , 8 , 8 , 8 , 2 , 2 , 4 , 4 , 5 , 5 , 1 , &
8 , 8 , 8 , 8 , 8 , 8 , 8 , 8 , 4 , 4 , 4 , 4 , 5 , 5 , 5 , 5 , 7 , 7 , 7 , 7 , 1 , 1 , 3 , 3 , 6 , 6 , 2 &
/ ) , ( / FE_Nips ( 7 ) , FE_NsubNodes ( 7 ) / ) )
2010-05-10 20:24:59 +05:30
!FE_subNodeParent(:FE_Nips(8),:FE_NsubNodes(8),8) ! element 117 has no subnodes
2010-08-17 04:23:24 +05:30
FE_subNodeParent ( : FE_Nips ( 9 ) , : FE_NsubNodes ( 9 ) , 9 ) = & ! element 57 (c3d20r == c3d8 --> copy of 7)
reshape ( ( / &
1 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 3 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 4 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , &
1 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , &
2 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , &
3 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , &
4 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , &
5 , 6 , 0 , 0 , 0 , 0 , 0 , 0 , &
6 , 7 , 0 , 0 , 0 , 0 , 0 , 0 , &
7 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , &
8 , 5 , 0 , 0 , 0 , 0 , 0 , 0 , &
1 , 2 , 3 , 4 , 0 , 0 , 0 , 0 , &
1 , 2 , 6 , 5 , 0 , 0 , 0 , 0 , &
2 , 3 , 7 , 6 , 0 , 0 , 0 , 0 , &
3 , 4 , 8 , 7 , 0 , 0 , 0 , 0 , &
1 , 4 , 8 , 5 , 0 , 0 , 0 , 0 , &
5 , 6 , 7 , 8 , 0 , 0 , 0 , 0 , &
1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 &
/ ) , ( / FE_Nips ( 9 ) , FE_NsubNodes ( 9 ) / ) )
2011-04-06 14:05:37 +05:30
FE_subNodeParent ( : FE_Nips ( 10 ) , : FE_NsubNodes ( 10 ) , 10 ) = & ! element 155, 125, 128
reshape ( ( / &
1 , 2 , 0 , &
2 , 3 , 0 , &
3 , 1 , 0 , &
1 , 2 , 3 &
/ ) , ( / FE_Nips ( 10 ) , FE_NsubNodes ( 10 ) / ) )
! *** FE_subNodeOnIPFace ***
! indicates which subnodes make up the interfaces enclosing the IP volume.
! The sorting convention is such that the outward pointing normal
! follows from a right-handed traversal of the face node list.
! For two-dimensional elements, which only have lines as "interface"
! one nevertheless has to specify each interface by a closed path,
! e.g., 1,2, 2,1, assuming the line connects nodes 1 and 2.
! This will result in zero ipVolume and interfaceArea, but is not
! detrimental at the moment since non-local constitutive laws are
! currently not foreseen in 2D cases.
2009-04-06 18:55:19 +05:30
FE_subNodeOnIPFace ( : FE_NipFaceNodes , : FE_NipNeighbors ( 1 ) , : FE_Nips ( 1 ) , 1 ) = & ! element 7
reshape ( ( / &
9 , 21 , 27 , 22 , & ! 1
1 , 13 , 25 , 12 , &
12 , 25 , 27 , 21 , &
1 , 9 , 22 , 13 , &
13 , 22 , 27 , 25 , &
1 , 12 , 21 , 9 , &
2 , 10 , 23 , 14 , & ! 2
9 , 22 , 27 , 21 , &
10 , 21 , 27 , 23 , &
2 , 14 , 22 , 9 , &
14 , 23 , 27 , 22 , &
2 , 9 , 21 , 10 , &
11 , 24 , 27 , 21 , & ! 3
4 , 12 , 25 , 16 , &
4 , 16 , 24 , 11 , &
12 , 21 , 27 , 25 , &
16 , 25 , 27 , 24 , &
4 , 11 , 21 , 12 , &
3 , 15 , 23 , 10 , & ! 4
11 , 21 , 27 , 24 , &
3 , 11 , 24 , 15 , &
10 , 23 , 27 , 21 , &
15 , 24 , 27 , 23 , &
3 , 10 , 21 , 11 , &
17 , 22 , 27 , 26 , & ! 5
5 , 20 , 25 , 13 , &
20 , 26 , 27 , 25 , &
5 , 13 , 22 , 17 , &
5 , 17 , 26 , 20 , &
13 , 25 , 27 , 22 , &
6 , 14 , 23 , 18 , & ! 6
17 , 26 , 27 , 22 , &
18 , 23 , 27 , 26 , &
6 , 17 , 22 , 14 , &
6 , 18 , 26 , 17 , &
14 , 22 , 27 , 23 , &
19 , 26 , 27 , 24 , & ! 7
8 , 16 , 25 , 20 , &
8 , 19 , 24 , 16 , &
20 , 25 , 27 , 26 , &
8 , 20 , 26 , 19 , &
16 , 24 , 27 , 25 , &
7 , 18 , 23 , 15 , & ! 8
19 , 24 , 27 , 26 , &
7 , 15 , 24 , 19 , &
18 , 26 , 27 , 23 , &
7 , 19 , 26 , 18 , &
15 , 23 , 27 , 24 &
/ ) , ( / FE_NipFaceNodes , FE_NipNeighbors ( 1 ) , FE_Nips ( 1 ) / ) )
FE_subNodeOnIPFace ( : FE_NipFaceNodes , : FE_NipNeighbors ( 2 ) , : FE_Nips ( 2 ) , 2 ) = & ! element 134
reshape ( ( / &
1 , 1 , 3 , 2 , & ! 1
1 , 1 , 2 , 4 , &
2 , 2 , 3 , 4 , &
1 , 1 , 4 , 3 &
/ ) , ( / FE_NipFaceNodes , FE_NipNeighbors ( 2 ) , FE_Nips ( 2 ) / ) )
FE_subNodeOnIPFace ( : FE_NipFaceNodes , : FE_NipNeighbors ( 3 ) , : FE_Nips ( 3 ) , 3 ) = & ! element 11
reshape ( ( / &
2011-04-06 14:05:37 +05:30
5 , 9 , 9 , 5 , & ! 1
1 , 8 , 8 , 1 , &
8 , 9 , 9 , 8 , &
1 , 5 , 5 , 1 , &
2 , 6 , 6 , 2 , & ! 2
5 , 9 , 9 , 5 , &
6 , 9 , 9 , 6 , &
2 , 5 , 5 , 2 , &
3 , 6 , 6 , 3 , & ! 3
7 , 9 , 9 , 7 , &
3 , 7 , 7 , 3 , &
6 , 9 , 9 , 6 , &
7 , 9 , 9 , 7 , & ! 4
4 , 8 , 8 , 4 , &
4 , 7 , 7 , 4 , &
8 , 9 , 9 , 8 &
2009-04-06 18:55:19 +05:30
/ ) , ( / FE_NipFaceNodes , FE_NipNeighbors ( 3 ) , FE_Nips ( 3 ) / ) )
FE_subNodeOnIPFace ( : FE_NipFaceNodes , : FE_NipNeighbors ( 4 ) , : FE_Nips ( 4 ) , 4 ) = & ! element 27
reshape ( ( / &
2011-04-06 14:05:37 +05:30
9 , 17 , 17 , 9 , & ! 1
1 , 16 , 16 , 1 , &
16 , 17 , 17 , 16 , &
1 , 9 , 9 , 1 , &
10 , 18 , 18 , 10 , & ! 2
9 , 17 , 17 , 9 , &
17 , 18 , 18 , 17 , &
9 , 10 , 10 , 9 , &
2 , 11 , 11 , 2 , & ! 3
10 , 18 , 18 , 10 , &
11 , 18 , 18 , 11 , &
2 , 10 , 10 , 2 , &
17 , 20 , 20 , 17 , & ! 4
15 , 16 , 16 , 15 , &
15 , 20 , 20 , 15 , &
16 , 17 , 17 , 16 , &
18 , 19 , 19 , 18 , & ! 5
17 , 20 , 20 , 17 , &
19 , 20 , 20 , 19 , &
17 , 18 , 18 , 17 , &
11 , 12 , 12 , 11 , & ! 6
18 , 19 , 19 , 18 , &
12 , 19 , 19 , 12 , &
11 , 18 , 18 , 11 , &
14 , 20 , 20 , 14 , & ! 7
4 , 15 , 15 , 4 , &
4 , 14 , 14 , 4 , &
15 , 20 , 20 , 15 , &
13 , 19 , 19 , 13 , & ! 8
14 , 20 , 20 , 14 , &
13 , 14 , 14 , 13 , &
19 , 20 , 20 , 19 , &
3 , 12 , 12 , 3 , & ! 9
13 , 19 , 19 , 13 , &
3 , 13 , 13 , 3 , &
12 , 19 , 19 , 12 &
2009-04-06 18:55:19 +05:30
/ ) , ( / FE_NipFaceNodes , FE_NipNeighbors ( 4 ) , FE_Nips ( 4 ) / ) )
!FE_subNodeOnIPFace(:FE_NipFaceNodes,:FE_NipNeighbors(5),:FE_Nips(5),5) = & ! element 157
! reshape((/&
! *still to be defined*
! /),(/FE_NipFaceNodes,FE_NipNeighbors(5),FE_Nips(5)/))
FE_subNodeOnIPFace ( : FE_NipFaceNodes , : FE_NipNeighbors ( 6 ) , : FE_Nips ( 6 ) , 6 ) = & ! element 136
reshape ( ( / &
7 , 16 , 21 , 17 , & ! 1
1 , 10 , 19 , 9 , &
9 , 19 , 21 , 16 , &
1 , 7 , 17 , 10 , &
10 , 17 , 21 , 19 , &
1 , 9 , 16 , 7 , &
2 , 8 , 18 , 11 , & ! 2
7 , 17 , 21 , 16 , &
8 , 16 , 21 , 18 , &
2 , 11 , 17 , 7 , &
11 , 18 , 21 , 17 , &
2 , 7 , 16 , 8 , &
8 , 18 , 21 , 16 , & ! 3
3 , 9 , 19 , 12 , &
3 , 12 , 18 , 8 , &
9 , 16 , 21 , 19 , &
12 , 19 , 21 , 18 , &
3 , 8 , 16 , 9 , &
13 , 17 , 21 , 20 , & ! 4
4 , 15 , 19 , 10 , &
15 , 20 , 21 , 19 , &
4 , 10 , 17 , 13 , &
4 , 13 , 20 , 15 , &
10 , 19 , 21 , 17 , &
5 , 11 , 18 , 14 , & ! 5
13 , 20 , 21 , 17 , &
14 , 18 , 21 , 20 , &
5 , 13 , 17 , 11 , &
5 , 14 , 20 , 13 , &
11 , 17 , 21 , 18 , &
14 , 20 , 21 , 18 , & ! 6
6 , 12 , 19 , 15 , &
6 , 14 , 18 , 12 , &
15 , 19 , 21 , 20 , &
6 , 15 , 20 , 14 , &
12 , 18 , 21 , 19 &
/ ) , ( / FE_NipFaceNodes , FE_NipNeighbors ( 6 ) , FE_Nips ( 6 ) / ) )
FE_subNodeOnIPFace ( : FE_NipFaceNodes , : FE_NipNeighbors ( 7 ) , : FE_Nips ( 7 ) , 7 ) = & ! element 21
reshape ( ( / &
9 , 33 , 57 , 37 , & ! 1
1 , 17 , 44 , 16 , &
33 , 16 , 44 , 57 , &
1 , 9 , 37 , 17 , &
17 , 37 , 57 , 44 , &
1 , 16 , 33 , 9 , &
10 , 34 , 58 , 38 , & ! 2
9 , 37 , 57 , 33 , &
34 , 33 , 57 , 58 , &
9 , 10 , 38 , 37 , &
37 , 38 , 58 , 57 , &
9 , 33 , 34 , 10 , &
2 , 11 , 39 , 18 , & ! 3
10 , 38 , 58 , 34 , &
11 , 34 , 58 , 39 , &
10 , 2 , 18 , 38 , &
38 , 18 , 39 , 58 , &
10 , 34 , 11 , 2 , &
33 , 36 , 60 , 57 , & ! 4
16 , 44 , 43 , 15 , &
36 , 15 , 43 , 60 , &
16 , 33 , 57 , 44 , &
44 , 57 , 60 , 43 , &
16 , 15 , 36 , 33 , &
34 , 35 , 59 , 58 , & ! 5
33 , 57 , 60 , 36 , &
35 , 36 , 60 , 59 , &
33 , 34 , 58 , 57 , &
57 , 58 , 59 , 60 , &
33 , 36 , 35 , 34 , &
11 , 12 , 40 , 39 , & ! 6
34 , 58 , 59 , 35 , &
12 , 35 , 59 , 40 , &
34 , 11 , 39 , 58 , &
58 , 39 , 40 , 59 , &
34 , 35 , 12 , 11 , &
36 , 14 , 42 , 60 , & ! 7
15 , 43 , 20 , 4 , &
14 , 4 , 20 , 42 , &
15 , 36 , 60 , 43 , &
43 , 60 , 42 , 20 , &
15 , 4 , 14 , 36 , &
35 , 13 , 41 , 59 , & ! 8
36 , 60 , 42 , 14 , &
13 , 14 , 42 , 41 , &
36 , 35 , 59 , 60 , &
60 , 59 , 41 , 42 , &
36 , 14 , 13 , 35 , &
12 , 3 , 19 , 40 , & ! 9
35 , 59 , 41 , 13 , &
3 , 13 , 41 , 19 , &
35 , 12 , 40 , 59 , &
59 , 40 , 19 , 41 , &
35 , 13 , 3 , 12 , &
37 , 57 , 61 , 45 , & ! 10
17 , 21 , 52 , 44 , &
57 , 44 , 52 , 61 , &
17 , 37 , 45 , 21 , &
21 , 45 , 61 , 52 , &
17 , 44 , 57 , 37 , &
38 , 58 , 62 , 46 , & ! 11
37 , 45 , 61 , 57 , &
58 , 57 , 61 , 62 , &
37 , 38 , 46 , 45 , &
45 , 46 , 62 , 61 , &
37 , 57 , 58 , 38 , &
18 , 39 , 47 , 22 , & ! 12
38 , 46 , 62 , 58 , &
39 , 58 , 62 , 47 , &
38 , 18 , 22 , 46 , &
46 , 22 , 47 , 62 , &
38 , 58 , 39 , 18 , &
57 , 60 , 64 , 61 , & ! 13
44 , 52 , 51 , 43 , &
60 , 43 , 51 , 64 , &
44 , 57 , 61 , 52 , &
52 , 61 , 64 , 51 , &
44 , 43 , 60 , 57 , &
58 , 59 , 63 , 62 , & ! 14
57 , 61 , 64 , 60 , &
59 , 60 , 64 , 63 , &
57 , 58 , 62 , 61 , &
61 , 62 , 63 , 64 , &
57 , 60 , 59 , 58 , &
39 , 40 , 48 , 47 , & ! 15
58 , 62 , 63 , 59 , &
40 , 59 , 63 , 48 , &
58 , 39 , 47 , 62 , &
62 , 47 , 48 , 63 , &
58 , 59 , 40 , 39 , &
60 , 42 , 50 , 64 , & ! 16
43 , 51 , 24 , 20 , &
42 , 20 , 24 , 50 , &
43 , 60 , 64 , 51 , &
51 , 64 , 50 , 24 , &
43 , 20 , 42 , 60 , &
59 , 41 , 49 , 63 , & ! 17
60 , 64 , 50 , 42 , &
41 , 42 , 50 , 49 , &
60 , 59 , 63 , 64 , &
64 , 63 , 49 , 50 , &
60 , 42 , 41 , 59 , &
40 , 19 , 23 , 48 , & ! 18
59 , 63 , 49 , 41 , &
19 , 41 , 49 , 23 , &
59 , 40 , 48 , 63 , &
63 , 48 , 23 , 49 , &
59 , 41 , 19 , 40 , &
45 , 61 , 53 , 25 , & ! 19
21 , 5 , 32 , 52 , &
61 , 52 , 32 , 53 , &
21 , 45 , 25 , 5 , &
5 , 25 , 53 , 32 , &
21 , 52 , 61 , 45 , &
46 , 62 , 54 , 26 , & ! 20
45 , 25 , 53 , 61 , &
62 , 61 , 53 , 54 , &
45 , 46 , 26 , 25 , &
25 , 26 , 54 , 53 , &
45 , 61 , 62 , 46 , &
22 , 47 , 27 , 6 , & ! 21
46 , 26 , 54 , 62 , &
47 , 62 , 54 , 27 , &
46 , 22 , 6 , 26 , &
26 , 6 , 27 , 54 , &
46 , 62 , 47 , 22 , &
61 , 64 , 56 , 53 , & ! 22
52 , 32 , 31 , 51 , &
64 , 51 , 31 , 56 , &
52 , 61 , 53 , 32 , &
32 , 53 , 56 , 31 , &
52 , 51 , 64 , 61 , &
62 , 63 , 55 , 54 , & ! 23
61 , 53 , 56 , 64 , &
63 , 64 , 56 , 55 , &
61 , 62 , 54 , 53 , &
53 , 54 , 55 , 56 , &
61 , 64 , 63 , 62 , &
47 , 48 , 28 , 27 , & ! 24
62 , 54 , 55 , 63 , &
48 , 63 , 55 , 28 , &
62 , 47 , 27 , 54 , &
54 , 27 , 28 , 55 , &
62 , 63 , 48 , 47 , &
64 , 50 , 30 , 56 , & ! 25
51 , 31 , 8 , 24 , &
50 , 24 , 8 , 30 , &
51 , 64 , 56 , 31 , &
31 , 56 , 30 , 8 , &
51 , 24 , 50 , 64 , &
63 , 49 , 29 , 55 , & ! 26
64 , 56 , 30 , 50 , &
49 , 50 , 30 , 29 , &
64 , 63 , 55 , 56 , &
56 , 55 , 29 , 30 , &
64 , 50 , 49 , 63 , &
48 , 23 , 7 , 28 , & ! 27
63 , 55 , 29 , 49 , &
23 , 49 , 29 , 7 , &
63 , 48 , 28 , 55 , &
55 , 28 , 7 , 29 , &
63 , 49 , 23 , 48 &
/ ) , ( / FE_NipFaceNodes , FE_NipNeighbors ( 7 ) , FE_Nips ( 7 ) / ) )
2010-05-10 20:24:59 +05:30
FE_subNodeOnIPFace ( : FE_NipFaceNodes , : FE_NipNeighbors ( 8 ) , : FE_Nips ( 8 ) , 8 ) = & ! element 117
reshape ( ( / &
2 , 3 , 7 , 6 , & ! 1
1 , 5 , 8 , 4 , &
3 , 4 , 8 , 7 , &
1 , 2 , 6 , 5 , &
5 , 6 , 7 , 8 , &
1 , 4 , 3 , 2 &
/ ) , ( / FE_NipFaceNodes , FE_NipNeighbors ( 8 ) , FE_Nips ( 8 ) / ) )
2010-08-17 04:23:24 +05:30
FE_subNodeOnIPFace ( : FE_NipFaceNodes , : FE_NipNeighbors ( 9 ) , : FE_Nips ( 9 ) , 9 ) = & ! element 57 (c3d20r == c3d8 --> copy of 7)
reshape ( ( / &
9 , 21 , 27 , 22 , & ! 1
1 , 13 , 25 , 12 , &
12 , 25 , 27 , 21 , &
1 , 9 , 22 , 13 , &
13 , 22 , 27 , 25 , &
1 , 12 , 21 , 9 , &
2 , 10 , 23 , 14 , & ! 2
9 , 22 , 27 , 21 , &
10 , 21 , 27 , 23 , &
2 , 14 , 22 , 9 , &
14 , 23 , 27 , 22 , &
2 , 9 , 21 , 10 , &
11 , 24 , 27 , 21 , & ! 3
4 , 12 , 25 , 16 , &
4 , 16 , 24 , 11 , &
12 , 21 , 27 , 25 , &
16 , 25 , 27 , 24 , &
4 , 11 , 21 , 12 , &
3 , 15 , 23 , 10 , & ! 4
11 , 21 , 27 , 24 , &
3 , 11 , 24 , 15 , &
10 , 23 , 27 , 21 , &
15 , 24 , 27 , 23 , &
3 , 10 , 21 , 11 , &
17 , 22 , 27 , 26 , & ! 5
5 , 20 , 25 , 13 , &
20 , 26 , 27 , 25 , &
5 , 13 , 22 , 17 , &
5 , 17 , 26 , 20 , &
13 , 25 , 27 , 22 , &
6 , 14 , 23 , 18 , & ! 6
17 , 26 , 27 , 22 , &
18 , 23 , 27 , 26 , &
6 , 17 , 22 , 14 , &
6 , 18 , 26 , 17 , &
14 , 22 , 27 , 23 , &
19 , 26 , 27 , 24 , & ! 7
8 , 16 , 25 , 20 , &
8 , 19 , 24 , 16 , &
20 , 25 , 27 , 26 , &
8 , 20 , 26 , 19 , &
16 , 24 , 27 , 25 , &
7 , 18 , 23 , 15 , & ! 8
19 , 24 , 27 , 26 , &
7 , 15 , 24 , 19 , &
18 , 26 , 27 , 23 , &
7 , 19 , 26 , 18 , &
15 , 23 , 27 , 24 &
/ ) , ( / FE_NipFaceNodes , FE_NipNeighbors ( 9 ) , FE_Nips ( 9 ) / ) )
2011-04-06 14:05:37 +05:30
FE_subNodeOnIPFace ( : FE_NipFaceNodes , : FE_NipNeighbors ( 10 ) , : FE_Nips ( 10 ) , 10 ) = & ! element 155, 125, 128
reshape ( ( / &
4 , 7 , 7 , 4 , & ! 1
1 , 6 , 6 , 1 , &
6 , 7 , 7 , 6 , &
1 , 4 , 4 , 1 , &
2 , 5 , 5 , 2 , & ! 2
4 , 7 , 7 , 4 , &
5 , 7 , 7 , 5 , &
2 , 4 , 4 , 2 , &
5 , 7 , 7 , 5 , & ! 3
3 , 6 , 6 , 3 , &
3 , 5 , 5 , 3 , &
6 , 7 , 7 , 6 &
/ ) , ( / FE_NipFaceNodes , FE_NipNeighbors ( 10 ) , FE_Nips ( 10 ) / ) )
2009-04-06 18:55:19 +05:30
return
2009-06-15 18:41:21 +05:30
endsubroutine
2009-04-06 18:55:19 +05:30
2009-10-12 21:31:49 +05:30
2007-04-10 16:52:53 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
! figure out table styles (Marc only)
2007-04-10 16:52:53 +05:30
!
2009-10-12 21:31:49 +05:30
! initialcondTableStyle, hypoelasticTableStyle
2007-04-10 16:52:53 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_marc_get_tableStyles ( unit )
2009-01-20 00:12:31 +05:30
2007-03-26 14:20:57 +05:30
use prec , only : pInt
2007-04-10 16:52:53 +05:30
use IO
2007-03-26 14:20:57 +05:30
implicit none
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) , parameter :: maxNchunks = 6
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
integer ( pInt ) unit
character ( len = 300 ) line
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
initialcondTableStyle = 0_pInt
hypoelasticTableStyle = 0_pInt
2007-04-10 16:52:53 +05:30
610 FORMAT ( A300 )
2009-01-20 00:12:31 +05:30
2007-04-10 16:52:53 +05:30
rewind ( unit )
do
read ( unit , 610 , END = 620 ) line
2009-10-12 21:31:49 +05:30
pos = IO_stringPos ( line , maxNchunks )
2009-01-20 00:12:31 +05:30
2010-04-29 15:13:31 +05:30
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == 'table' . and . pos ( 1 ) . GT . 5 ) then
2009-10-12 21:31:49 +05:30
initialcondTableStyle = IO_intValue ( line , pos , 4 )
hypoelasticTableStyle = IO_intValue ( line , pos , 5 )
exit
endif
2009-06-15 18:41:21 +05:30
enddo
2009-01-20 00:12:31 +05:30
2007-04-10 16:52:53 +05:30
620 return
2007-03-26 14:20:57 +05:30
2009-06-15 18:41:21 +05:30
endsubroutine
2009-01-20 00:12:31 +05:30
2011-02-16 21:53:08 +05:30
!********************************************************************
! get any additional mpie options from input file (Marc only)
!
! mesh_periodicSurface
!********************************************************************
subroutine mesh_marc_get_mpieOptions ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , intent ( in ) :: unit
integer ( pInt ) , parameter :: maxNchunks = 5
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
integer ( pInt ) chunk
character ( len = 300 ) line
mesh_periodicSurface = ( / . false . , . false . , . false . / )
610 FORMAT ( A300 )
rewind ( unit )
do
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '$mpie' ) then ! found keyword for user defined input
if ( IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'periodic' & ! found keyword 'periodic'
2011-02-23 18:03:51 +05:30
. and . pos ( 1 ) > 2 ) then ! and there is at least one more chunk to read
2011-02-16 21:53:08 +05:30
do chunk = 2 , pos ( 1 ) ! loop through chunks (skipping the keyword)
select case ( IO_stringValue ( line , pos , chunk ) ) ! chunk matches keyvalues x,y or z?
case ( 'x' )
mesh_periodicSurface ( 1 ) = . true .
case ( 'y' )
mesh_periodicSurface ( 2 ) = . true .
case ( 'z' )
mesh_periodicSurface ( 3 ) = . true .
end select
enddo
endif
endif
enddo
620 return
endsubroutine
2007-03-26 14:20:57 +05:30
2010-05-06 22:10:47 +05:30
!********************************************************************
! count overall number of nodes and elements in mesh
!
! mesh_Nelems, mesh_Nnodes
!********************************************************************
subroutine mesh_spectral_count_nodesAndElements ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 7
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
integer ( pInt ) a , b , c , i
integer ( pInt ) unit
character ( len = 1024 ) line
mesh_Nnodes = 0_pInt
mesh_Nelems = 0_pInt
rewind ( unit )
do
read ( unit , '(a1024)' , END = 100 ) line
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_StringValue ( line , pos , 1 ) ) == 'resolution' ) then
2010-05-10 20:24:59 +05:30
do i = 2 , 6 , 2
select case ( IO_lc ( IO_stringValue ( line , pos , i ) ) )
case ( 'a' )
a = IO_intValue ( line , pos , i + 1 )
case ( 'b' )
b = IO_intValue ( line , pos , i + 1 )
case ( 'c' )
c = IO_intValue ( line , pos , i + 1 )
2010-05-06 22:10:47 +05:30
end select
enddo
2010-10-01 16:12:15 +05:30
mesh_Nelems = a * b * c
mesh_Nnodes = ( 1 + a ) * ( 1 + b ) * ( 1 + c )
2010-05-06 22:10:47 +05:30
exit
endif
enddo
100 return
endsubroutine
2009-10-12 21:31:49 +05:30
!********************************************************************
! count overall number of nodes and elements in mesh
2007-03-27 18:23:31 +05:30
!
2009-10-12 21:31:49 +05:30
! mesh_Nelems, mesh_Nnodes
2007-04-10 16:52:53 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_marc_count_nodesAndElements ( unit )
2007-03-21 21:48:33 +05:30
use prec , only : pInt
2007-04-10 16:52:53 +05:30
use IO
2007-03-21 21:48:33 +05:30
implicit none
2009-10-12 21:31:49 +05:30
integer ( pInt ) , parameter :: maxNchunks = 4
2009-04-03 12:33:25 +05:30
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
2009-10-12 21:31:49 +05:30
integer ( pInt ) unit
character ( len = 300 ) line
mesh_Nnodes = 0_pInt
mesh_Nelems = 0_pInt
2007-04-10 16:52:53 +05:30
610 FORMAT ( A300 )
2009-10-12 21:31:49 +05:30
2007-04-10 16:52:53 +05:30
rewind ( unit )
2009-10-12 21:31:49 +05:30
do
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_StringValue ( line , pos , 1 ) ) == 'sizing' ) then
mesh_Nelems = IO_IntValue ( line , pos , 3 )
mesh_Nnodes = IO_IntValue ( line , pos , 4 )
2007-09-28 20:26:26 +05:30
exit
2009-06-15 18:41:21 +05:30
endif
enddo
2009-10-12 21:31:49 +05:30
620 return
2009-04-03 12:33:25 +05:30
2009-06-15 18:41:21 +05:30
endsubroutine
2009-04-03 12:33:25 +05:30
2007-10-23 18:39:46 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
! count overall number of nodes and elements in mesh
2007-10-23 18:39:46 +05:30
!
2009-10-12 21:31:49 +05:30
! mesh_Nelems, mesh_Nnodes
2007-10-23 18:39:46 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_abaqus_count_nodesAndElements ( unit )
2009-01-20 00:12:31 +05:30
2007-10-23 18:39:46 +05:30
use prec , only : pInt
use IO
implicit none
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) unit
logical inPart
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
mesh_Nnodes = 0
mesh_Nelems = 0
610 FORMAT ( A300 )
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
inPart = . false .
2007-10-23 18:39:46 +05:30
rewind ( unit )
2009-10-12 21:31:49 +05:30
do
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*part' ) inPart = . true .
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*end' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'part' ) inPart = . false .
2010-07-13 15:56:07 +05:30
if ( inPart . or . noPart ) then
2009-10-12 21:31:49 +05:30
select case ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) )
case ( '*node' )
if ( &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'output' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'print' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'file' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'response' &
) &
mesh_Nnodes = mesh_Nnodes + IO_countDataLines ( unit )
case ( '*element' )
if ( &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'output' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'matrix' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'response' &
) then
mesh_Nelems = mesh_Nelems + IO_countDataLines ( unit )
endif
endselect
2009-06-15 18:41:21 +05:30
endif
enddo
2010-07-13 15:56:07 +05:30
620 if ( mesh_Nnodes < 2 ) call IO_error ( 900 )
if ( mesh_Nelems == 0 ) call IO_error ( 901 )
2009-10-12 21:31:49 +05:30
2010-07-13 15:56:07 +05:30
return
2009-10-12 21:31:49 +05:30
2009-06-15 18:41:21 +05:30
endsubroutine
2009-01-20 00:12:31 +05:30
2007-04-25 13:03:24 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
! count overall number of element sets in mesh
2007-04-25 13:03:24 +05:30
!
2009-10-12 21:31:49 +05:30
! mesh_NelemSets, mesh_maxNelemInSet
2007-04-25 13:03:24 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_marc_count_elementSets ( unit )
2009-01-20 00:12:31 +05:30
2007-04-25 13:03:24 +05:30
use prec , only : pInt
use IO
implicit none
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) , parameter :: maxNchunks = 2
2009-04-03 12:33:25 +05:30
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) unit
character ( len = 300 ) line
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
mesh_NelemSets = 0_pInt
mesh_maxNelemInSet = 0_pInt
610 FORMAT ( A300 )
2009-01-20 00:12:31 +05:30
2007-04-25 13:03:24 +05:30
rewind ( unit )
2009-10-12 21:31:49 +05:30
do
read ( unit , 610 , END = 620 ) line
2009-04-03 12:33:25 +05:30
pos = IO_stringPos ( line , maxNchunks )
2009-10-12 21:31:49 +05:30
if ( IO_lc ( IO_StringValue ( line , pos , 1 ) ) == 'define' . and . &
IO_lc ( IO_StringValue ( line , pos , 2 ) ) == 'element' ) then
mesh_NelemSets = mesh_NelemSets + 1_pInt
mesh_maxNelemInSet = max ( mesh_maxNelemInSet , &
IO_countContinousIntValues ( unit ) )
2009-06-15 18:41:21 +05:30
endif
enddo
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
620 return
2009-06-15 18:41:21 +05:30
endsubroutine
2007-04-25 13:03:24 +05:30
2009-01-20 00:12:31 +05:30
2007-04-10 16:52:53 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
! count overall number of element sets in mesh
2007-04-10 16:52:53 +05:30
!
2009-10-12 21:31:49 +05:30
! mesh_NelemSets, mesh_maxNelemInSet
2007-04-10 16:52:53 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_abaqus_count_elementSets ( unit )
2009-01-20 00:12:31 +05:30
2007-04-10 16:52:53 +05:30
use prec , only : pInt
use IO
implicit none
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) unit
logical inPart
mesh_NelemSets = 0_pInt
mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons
2007-04-10 16:52:53 +05:30
610 FORMAT ( A300 )
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
inPart = . false .
2007-04-10 16:52:53 +05:30
rewind ( unit )
2009-10-12 21:31:49 +05:30
do
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*part' ) inPart = . true .
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*end' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'part' ) inPart = . false .
2010-07-13 15:56:07 +05:30
if ( ( inPart . or . noPart ) . and . IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*elset' ) &
2009-10-12 21:31:49 +05:30
mesh_NelemSets = mesh_NelemSets + 1_pInt
2009-06-15 18:41:21 +05:30
enddo
2009-01-20 00:12:31 +05:30
2010-07-13 15:56:07 +05:30
620 continue
if ( mesh_NelemSets == 0 ) call IO_error ( 902 )
return
2009-06-15 18:41:21 +05:30
endsubroutine
2007-04-10 16:52:53 +05:30
2009-01-20 00:12:31 +05:30
2007-04-25 13:03:24 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
! count overall number of solid sections sets in mesh (Abaqus only)
2007-04-10 16:52:53 +05:30
!
2009-10-12 21:31:49 +05:30
! mesh_Nmaterials
2007-04-25 13:03:24 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_abaqus_count_materials ( unit )
2009-01-20 00:12:31 +05:30
2007-04-25 13:03:24 +05:30
use prec , only : pInt
use IO
implicit none
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) unit
logical inPart
mesh_Nmaterials = 0_pInt
2007-04-25 13:03:24 +05:30
610 FORMAT ( A300 )
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
inPart = . false .
2007-04-25 13:03:24 +05:30
rewind ( unit )
2009-10-12 21:31:49 +05:30
do
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*part' ) inPart = . true .
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*end' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'part' ) inPart = . false .
2010-07-13 15:56:07 +05:30
if ( ( inPart . or . noPart ) . and . &
2009-10-12 21:31:49 +05:30
IO_lc ( IO_StringValue ( line , pos , 1 ) ) == '*solid' . and . &
IO_lc ( IO_StringValue ( line , pos , 2 ) ) == 'section' ) &
mesh_Nmaterials = mesh_Nmaterials + 1_pInt
2009-06-15 18:41:21 +05:30
enddo
2009-01-20 00:12:31 +05:30
2010-07-13 15:56:07 +05:30
620 if ( mesh_Nmaterials == 0 ) call IO_error ( 903 )
return
2009-06-15 18:41:21 +05:30
endsubroutine
2007-04-25 13:03:24 +05:30
2009-01-20 00:12:31 +05:30
2010-05-06 22:10:47 +05:30
!********************************************************************
! count overall number of cpElements in mesh
!
! mesh_NcpElems
!********************************************************************
subroutine mesh_spectral_count_cpElements ( )
use prec , only : pInt
implicit none
mesh_NcpElems = mesh_Nelems
return
endsubroutine
2007-04-25 13:03:24 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
! count overall number of cpElements in mesh
2007-04-10 16:52:53 +05:30
!
2009-10-12 21:31:49 +05:30
! mesh_NcpElems
2007-04-25 13:03:24 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_marc_count_cpElements ( unit )
2009-01-20 00:12:31 +05:30
2007-04-25 13:03:24 +05:30
use prec , only : pInt
use IO
implicit none
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) , parameter :: maxNchunks = 1
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
2009-04-03 12:33:25 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) unit , i
character ( len = 300 ) line
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
mesh_NcpElems = 0_pInt
2009-01-20 00:12:31 +05:30
2007-04-25 13:03:24 +05:30
610 FORMAT ( A300 )
2007-04-10 16:52:53 +05:30
rewind ( unit )
2009-10-12 21:31:49 +05:30
do
2009-04-03 12:33:25 +05:30
read ( unit , 610 , END = 620 ) line
2009-10-12 21:31:49 +05:30
pos = IO_stringPos ( line , maxNchunks )
2009-04-03 12:33:25 +05:30
2009-10-12 21:31:49 +05:30
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == 'hypoelastic' ) then
do i = 1 , 3 + hypoelasticTableStyle ! Skip 3 or 4 lines
2009-04-03 12:33:25 +05:30
read ( unit , 610 , END = 620 ) line
enddo
2009-10-12 21:31:49 +05:30
mesh_NcpElems = mesh_NcpElems + IO_countContinousIntValues ( unit )
exit
2009-04-03 12:33:25 +05:30
endif
enddo
2009-01-20 00:12:31 +05:30
2009-04-03 12:33:25 +05:30
620 return
2009-10-12 21:31:49 +05:30
2009-06-15 18:41:21 +05:30
endsubroutine
2007-04-25 13:03:24 +05:30
2009-10-12 21:31:49 +05:30
2007-04-10 16:52:53 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
! count overall number of cpElements in mesh
2007-04-10 16:52:53 +05:30
!
2009-10-12 21:31:49 +05:30
! mesh_NcpElems
2007-04-10 16:52:53 +05:30
!********************************************************************
2009-10-12 21:31:49 +05:30
subroutine mesh_abaqus_count_cpElements ( unit )
2009-01-20 00:12:31 +05:30
2007-04-10 16:52:53 +05:30
use prec , only : pInt
use IO
implicit none
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
2009-01-20 00:12:31 +05:30
2011-03-23 21:50:12 +05:30
integer ( pInt ) unit , i , k
2009-10-12 21:31:49 +05:30
logical materialFound
character ( len = 64 ) materialName , elemSetName
mesh_NcpElems = 0
610 FORMAT ( A300 )
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
rewind ( unit )
do
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks )
select case ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) )
case ( '*material' )
2011-03-23 21:50:12 +05:30
materialName = IO_extractValue ( IO_lc ( IO_stringValue ( line , pos , 2 ) ) , 'name' ) ! extract name=value
materialFound = materialName / = '' ! valid name?
2009-10-12 21:31:49 +05:30
case ( '*user' )
if ( IO_lc ( IO_StringValue ( line , pos , 2 ) ) == 'material' . and . materialFound ) then
2011-03-23 21:50:12 +05:30
do i = 1 , mesh_Nmaterials ! look thru material names
if ( materialName == mesh_nameMaterial ( i ) ) then ! found one
elemSetName = mesh_mapMaterial ( i ) ! take corresponding elemSet
do k = 1 , mesh_NelemSets ! look thru all elemSet definitions
if ( elemSetName == mesh_nameElemSet ( k ) ) & ! matched?
mesh_NcpElems = mesh_NcpElems + mesh_mapElemSet ( 1 , k ) ! add those elem count
enddo
endif
2009-10-12 21:31:49 +05:30
enddo
materialFound = . false .
endif
endselect
2009-06-15 18:41:21 +05:30
enddo
2011-03-23 21:50:12 +05:30
2010-07-13 15:56:07 +05:30
620 if ( mesh_NcpElems == 0 ) call IO_error ( 906 )
return
2009-10-12 21:31:49 +05:30
endsubroutine
2009-01-20 00:12:31 +05:30
2009-10-12 21:31:49 +05:30
!********************************************************************
! map element sets
2007-04-10 16:52:53 +05:30
!
2009-10-12 21:31:49 +05:30
! allocate globals: mesh_nameElemSet, mesh_mapElemSet
!********************************************************************
subroutine mesh_marc_map_elementSets ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 4
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) unit , elemSet
allocate ( mesh_nameElemSet ( mesh_NelemSets ) ) ; mesh_nameElemSet = ''
allocate ( mesh_mapElemSet ( 1 + mesh_maxNelemInSet , mesh_NelemSets ) ) ; mesh_mapElemSet = 0_pInt
610 FORMAT ( A300 )
elemSet = 0_pInt
rewind ( unit )
do
read ( unit , 610 , END = 640 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == 'define' ) . and . &
( IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'element' ) ) then
elemSet = elemSet + 1
mesh_nameElemSet ( elemSet ) = IO_stringValue ( line , pos , 4 )
mesh_mapElemSet ( : , elemSet ) = IO_continousIntValues ( unit , mesh_maxNelemInSet , mesh_nameElemSet , mesh_mapElemSet , mesh_NelemSets )
endif
enddo
640 return
endsubroutine
!********************************************************************
! Build element set mapping
!
! allocate globals: mesh_nameElemSet, mesh_mapElemSet
!********************************************************************
subroutine mesh_abaqus_map_elementSets ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 4
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
2010-07-13 15:56:07 +05:30
integer ( pInt ) unit , elemSet , i
2009-10-12 21:31:49 +05:30
logical inPart
allocate ( mesh_nameElemSet ( mesh_NelemSets ) ) ; mesh_nameElemSet = ''
allocate ( mesh_mapElemSet ( 1 + mesh_maxNelemInSet , mesh_NelemSets ) ) ; mesh_mapElemSet = 0_pInt
610 FORMAT ( A300 )
elemSet = 0_pInt
inPart = . false .
rewind ( unit )
do
read ( unit , 610 , END = 640 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*part' ) inPart = . true .
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*end' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'part' ) inPart = . false .
2010-07-13 15:56:07 +05:30
if ( ( inPart . or . noPart ) . and . IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*elset' ) then
2009-10-12 21:31:49 +05:30
elemSet = elemSet + 1_pInt
mesh_nameElemSet ( elemSet ) = IO_extractValue ( IO_lc ( IO_stringValue ( line , pos , 2 ) ) , 'elset' )
mesh_mapElemSet ( : , elemSet ) = IO_continousIntValues ( unit , mesh_Nelems , mesh_nameElemSet , mesh_mapElemSet , elemSet - 1 )
endif
enddo
2010-07-13 15:56:07 +05:30
640 do i = 1 , elemSet
! write(6,*)'elemSetName: ',mesh_nameElemSet(i)
! write(6,*)'elems in Elset',mesh_mapElemSet(:,i)
if ( mesh_mapElemSet ( 1 , i ) == 0 ) call IO_error ( ID = 904 , ext_msg = mesh_nameElemSet ( i ) )
enddo
2009-10-12 21:31:49 +05:30
2010-07-13 15:56:07 +05:30
return
2009-10-12 21:31:49 +05:30
endsubroutine
!********************************************************************
! map solid section (Abaqus only)
!
! allocate globals: mesh_nameMaterial, mesh_mapMaterial
!********************************************************************
subroutine mesh_abaqus_map_materials ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 20
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) unit , i , count
2011-04-13 19:46:22 +05:30
logical inPart
2009-10-12 21:31:49 +05:30
character ( len = 64 ) elemSetName , materialName
allocate ( mesh_nameMaterial ( mesh_Nmaterials ) ) ; mesh_nameMaterial = ''
allocate ( mesh_mapMaterial ( mesh_Nmaterials ) ) ; mesh_mapMaterial = ''
610 FORMAT ( A300 )
count = 0
inPart = . false .
rewind ( unit )
do
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*part' ) inPart = . true .
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*end' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'part' ) inPart = . false .
2010-07-13 15:56:07 +05:30
if ( ( inPart . or . noPart ) . and . &
2009-10-12 21:31:49 +05:30
IO_lc ( IO_StringValue ( line , pos , 1 ) ) == '*solid' . and . &
IO_lc ( IO_StringValue ( line , pos , 2 ) ) == 'section' ) then
elemSetName = ''
materialName = ''
do i = 3 , pos ( 1 )
if ( IO_extractValue ( IO_lc ( IO_stringValue ( line , pos , i ) ) , 'elset' ) / = '' ) &
elemSetName = IO_extractValue ( IO_lc ( IO_stringValue ( line , pos , i ) ) , 'elset' )
if ( IO_extractValue ( IO_lc ( IO_stringValue ( line , pos , i ) ) , 'material' ) / = '' ) &
materialName = IO_extractValue ( IO_lc ( IO_stringValue ( line , pos , i ) ) , 'material' )
enddo
if ( elemSetName / = '' . and . materialName / = '' ) then
count = count + 1_pInt
mesh_nameMaterial ( count ) = materialName ! name of material used for this section
mesh_mapMaterial ( count ) = elemSetName ! mapped to respective element set
endif
endif
enddo
2010-07-13 15:56:07 +05:30
620 if ( count == 0 ) call IO_error ( 905 )
do i = 1 , count
! write(6,*)'name of materials: ',i,mesh_nameMaterial(i)
! write(6,*)'name of elemSets: ',i,mesh_mapMaterial(i)
if ( mesh_nameMaterial ( i ) == '' . or . mesh_mapMaterial ( i ) == '' ) call IO_error ( 905 )
enddo
2009-10-12 21:31:49 +05:30
2010-07-13 15:56:07 +05:30
return
2009-10-12 21:31:49 +05:30
endsubroutine
2010-05-06 22:10:47 +05:30
!********************************************************************
! map nodes from FE id to internal (consecutive) representation
!
! allocate globals: mesh_mapFEtoCPnode
!********************************************************************
subroutine mesh_spectral_map_nodes ( )
use prec , only : pInt
implicit none
integer ( pInt ) i
allocate ( mesh_mapFEtoCPnode ( 2 , mesh_Nnodes ) ) ; mesh_mapFEtoCPnode = 0_pInt
forall ( i = 1 : mesh_Nnodes ) &
mesh_mapFEtoCPnode ( : , i ) = i
return
2010-07-13 15:56:07 +05:30
2010-05-06 22:10:47 +05:30
endsubroutine
!********************************************************************
2009-10-12 21:31:49 +05:30
! map nodes from FE id to internal (consecutive) representation
!
! allocate globals: mesh_mapFEtoCPnode
!********************************************************************
subroutine mesh_marc_map_nodes ( unit )
use prec , only : pInt
use math , only : qsort
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 1
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) , dimension ( mesh_Nnodes ) :: node_count
integer ( pInt ) unit , i
allocate ( mesh_mapFEtoCPnode ( 2 , mesh_Nnodes ) ) ; mesh_mapFEtoCPnode = 0_pInt
610 FORMAT ( A300 )
node_count = 0_pInt
rewind ( unit )
do
read ( unit , 610 , END = 650 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == 'coordinates' ) then
read ( unit , 610 , END = 650 ) line ! skip crap line
do i = 1 , mesh_Nnodes
read ( unit , 610 , END = 650 ) line
mesh_mapFEtoCPnode ( 1 , i ) = IO_fixedIntValue ( line , ( / 0 , 10 / ) , 1 )
mesh_mapFEtoCPnode ( 2 , i ) = i
enddo
exit
endif
enddo
650 call qsort ( mesh_mapFEtoCPnode , 1 , size ( mesh_mapFEtoCPnode , 2 ) )
return
endsubroutine
!********************************************************************
! map nodes from FE id to internal (consecutive) representation
!
! allocate globals: mesh_mapFEtoCPnode
!********************************************************************
subroutine mesh_abaqus_map_nodes ( unit )
use prec , only : pInt
use math , only : qsort
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) unit , i , count , cpNode
logical inPart
allocate ( mesh_mapFEtoCPnode ( 2 , mesh_Nnodes ) ) ; mesh_mapFEtoCPnode = 0_pInt
610 FORMAT ( A300 )
cpNode = 0_pInt
inPart = . false .
rewind ( unit )
do
read ( unit , 610 , END = 650 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*part' ) inPart = . true .
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*end' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'part' ) inPart = . false .
2010-07-13 15:56:07 +05:30
if ( ( inPart . or . noPart ) . and . &
2009-10-12 21:31:49 +05:30
IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*node' . and . &
( IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'output' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'print' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'file' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'response' ) &
) then
count = IO_countDataLines ( unit )
do i = 1 , count
backspace ( unit )
enddo
do i = 1 , count
read ( unit , 610 , END = 650 ) line
pos = IO_stringPos ( line , maxNchunks )
cpNode = cpNode + 1_pInt
mesh_mapFEtoCPnode ( 1 , cpNode ) = IO_intValue ( line , pos , 1 )
mesh_mapFEtoCPnode ( 2 , cpNode ) = cpNode
enddo
endif
enddo
650 call qsort ( mesh_mapFEtoCPnode , 1 , size ( mesh_mapFEtoCPnode , 2 ) )
2010-07-13 15:56:07 +05:30
if ( size ( mesh_mapFEtoCPnode ) == 0 ) call IO_error ( 908 )
2009-10-12 21:31:49 +05:30
return
endsubroutine
2010-05-06 22:10:47 +05:30
!********************************************************************
! map elements from FE id to internal (consecutive) representation
!
! allocate globals: mesh_mapFEtoCPelem
!********************************************************************
subroutine mesh_spectral_map_elements ( )
use prec , only : pInt
implicit none
integer ( pInt ) i
allocate ( mesh_mapFEtoCPelem ( 2 , mesh_NcpElems ) ) ; mesh_mapFEtoCPelem = 0_pInt
forall ( i = 1 : mesh_NcpElems ) &
mesh_mapFEtoCPelem ( : , i ) = i
return
2010-07-01 20:50:39 +05:30
2010-05-06 22:10:47 +05:30
endsubroutine
2009-10-12 21:31:49 +05:30
!********************************************************************
! map elements from FE id to internal (consecutive) representation
!
! allocate globals: mesh_mapFEtoCPelem
!********************************************************************
subroutine mesh_marc_map_elements ( unit )
use prec , only : pInt
use math , only : qsort
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 1
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) , dimension ( 1 + mesh_NcpElems ) :: contInts
integer ( pInt ) unit , i , cpElem
allocate ( mesh_mapFEtoCPelem ( 2 , mesh_NcpElems ) ) ; mesh_mapFEtoCPelem = 0_pInt
610 FORMAT ( A300 )
cpElem = 0_pInt
rewind ( unit )
do
read ( unit , 610 , END = 660 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == 'hypoelastic' ) then
do i = 1 , 3 + hypoelasticTableStyle ! skip three (or four if new table style!) lines
read ( unit , 610 , END = 660 ) line
enddo
contInts = IO_continousIntValues ( unit , mesh_NcpElems , mesh_nameElemSet , mesh_mapElemSet , mesh_NelemSets )
do i = 1 , contInts ( 1 )
cpElem = cpElem + 1
mesh_mapFEtoCPelem ( 1 , cpElem ) = contInts ( 1 + i )
mesh_mapFEtoCPelem ( 2 , cpElem ) = cpElem
enddo
endif
enddo
660 call qsort ( mesh_mapFEtoCPelem , 1 , size ( mesh_mapFEtoCPelem , 2 ) ) ! should be mesh_NcpElems
return
endsubroutine
!********************************************************************
! map elements from FE id to internal (consecutive) representation
!
! allocate globals: mesh_mapFEtoCPelem
!********************************************************************
subroutine mesh_abaqus_map_elements ( unit )
use prec , only : pInt
use math , only : qsort
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
2011-03-23 21:50:12 +05:30
integer ( pInt ) unit , i , j , k , cpElem
2009-10-12 21:31:49 +05:30
logical materialFound
character ( len = 64 ) materialName , elemSetName
allocate ( mesh_mapFEtoCPelem ( 2 , mesh_NcpElems ) ) ; mesh_mapFEtoCPelem = 0_pInt
610 FORMAT ( A300 )
cpElem = 0_pInt
rewind ( unit )
do
read ( unit , 610 , END = 660 ) line
pos = IO_stringPos ( line , maxNchunks )
select case ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) )
case ( '*material' )
2011-03-23 21:50:12 +05:30
materialName = IO_extractValue ( IO_lc ( IO_stringValue ( line , pos , 2 ) ) , 'name' ) ! extract name=value
materialFound = materialName / = '' ! valid name?
2009-10-12 21:31:49 +05:30
case ( '*user' )
if ( IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'material' . and . materialFound ) then
2011-03-23 21:50:12 +05:30
do i = 1 , mesh_Nmaterials ! look thru material names
if ( materialName == mesh_nameMaterial ( i ) ) then ! found one
elemSetName = mesh_mapMaterial ( i ) ! take corresponding elemSet
do k = 1 , mesh_NelemSets ! look thru all elemSet definitions
if ( elemSetName == mesh_nameElemSet ( k ) ) then ! matched?
do j = 1 , mesh_mapElemSet ( 1 , k )
cpElem = cpElem + 1_pInt
mesh_mapFEtoCPelem ( 1 , cpElem ) = mesh_mapElemSet ( 1 + j , k ) ! store FE id
mesh_mapFEtoCPelem ( 2 , cpElem ) = cpElem ! store our id
enddo
endif
enddo
endif
2009-10-12 21:31:49 +05:30
enddo
materialFound = . false .
endif
endselect
enddo
660 call qsort ( mesh_mapFEtoCPelem , 1 , size ( mesh_mapFEtoCPelem , 2 ) ) ! should be mesh_NcpElems
2010-07-13 15:56:07 +05:30
if ( size ( mesh_mapFEtoCPelem ) < 2 ) call IO_error ( 907 )
2009-10-12 21:31:49 +05:30
return
endsubroutine
2010-05-06 22:10:47 +05:30
!********************************************************************
! get maximum count of nodes, IPs, IP neighbors, and subNodes
! among cpElements
!
! _maxNnodes, _maxNips, _maxNipNeighbors, _maxNsubNodes
!********************************************************************
subroutine mesh_spectral_count_cpSizes ( )
use prec , only : pInt
implicit none
integer ( pInt ) t
t = FE_mapElemtype ( 'C3D8R' ) ! fake 3D hexahedral 8 node 1 IP element
mesh_maxNnodes = FE_Nnodes ( t )
mesh_maxNips = FE_Nips ( t )
mesh_maxNipNeighbors = FE_NipNeighbors ( t )
mesh_maxNsubNodes = FE_NsubNodes ( t )
2010-07-01 20:50:39 +05:30
2010-05-06 22:10:47 +05:30
endsubroutine
2009-10-12 21:31:49 +05:30
!********************************************************************
! get maximum count of nodes, IPs, IP neighbors, and subNodes
! among cpElements
!
! _maxNnodes, _maxNips, _maxNipNeighbors, _maxNsubNodes
!********************************************************************
subroutine mesh_marc_count_cpSizes ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) unit , i , t , e
mesh_maxNnodes = 0_pInt
mesh_maxNips = 0_pInt
mesh_maxNipNeighbors = 0_pInt
mesh_maxNsubNodes = 0_pInt
610 FORMAT ( A300 )
rewind ( unit )
do
read ( unit , 610 , END = 630 ) line
2010-08-04 05:17:00 +05:30
pos = IO_stringPos ( line , maxNchunks )
2009-10-12 21:31:49 +05:30
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == 'connectivity' ) then
read ( unit , 610 , END = 630 ) line ! Garbage line
do i = 1 , mesh_Nelems ! read all elements
read ( unit , 610 , END = 630 ) line
pos = IO_stringPos ( line , maxNchunks ) ! limit to id and type
e = mesh_FEasCP ( 'elem' , IO_intValue ( line , pos , 1 ) )
if ( e / = 0 ) then
t = FE_mapElemtype ( IO_stringValue ( line , pos , 2 ) )
mesh_maxNnodes = max ( mesh_maxNnodes , FE_Nnodes ( t ) )
mesh_maxNips = max ( mesh_maxNips , FE_Nips ( t ) )
mesh_maxNipNeighbors = max ( mesh_maxNipNeighbors , FE_NipNeighbors ( t ) )
mesh_maxNsubNodes = max ( mesh_maxNsubNodes , FE_NsubNodes ( t ) )
call IO_skipChunks ( unit , FE_NoriginalNodes ( t ) - ( pos ( 1 ) - 2 ) ) ! read on if FE_Nnodes exceeds node count present on current line
endif
enddo
exit
endif
enddo
630 return
endsubroutine
!********************************************************************
! get maximum count of nodes, IPs, IP neighbors, and subNodes
! among cpElements
!
! _maxNnodes, _maxNips, _maxNipNeighbors, _maxNsubNodes
!********************************************************************
subroutine mesh_abaqus_count_cpSizes ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 2
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) unit , i , count , t
logical inPart
mesh_maxNnodes = 0_pInt
mesh_maxNips = 0_pInt
mesh_maxNipNeighbors = 0_pInt
mesh_maxNsubNodes = 0_pInt
610 FORMAT ( A300 )
inPart = . false .
rewind ( unit )
do
read ( unit , 610 , END = 620 ) line
2010-08-04 05:17:00 +05:30
pos = IO_stringPos ( line , maxNchunks )
2009-10-12 21:31:49 +05:30
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*part' ) inPart = . true .
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*end' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'part' ) inPart = . false .
2010-07-13 15:56:07 +05:30
if ( ( inPart . or . noPart ) . and . &
2009-10-12 21:31:49 +05:30
IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*element' . and . &
( IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'output' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'matrix' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'response' ) &
) then
2010-07-13 15:56:07 +05:30
t = FE_mapElemtype ( IO_extractValue ( IO_lc ( IO_stringValue ( line , pos , 2 ) ) , 'type' ) ) ! remember elem type
if ( t == 0 ) call IO_error ( ID = 910 , ext_msg = 'mesh_abaqus_count_cpSizes' )
2009-10-12 21:31:49 +05:30
count = IO_countDataLines ( unit )
do i = 1 , count
backspace ( unit )
enddo
do i = 1 , count
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks ) ! limit to 64 nodes max
if ( mesh_FEasCP ( 'elem' , IO_intValue ( line , pos , 1 ) ) / = 0 ) then ! disregard non CP elems
mesh_maxNnodes = max ( mesh_maxNnodes , FE_Nnodes ( t ) )
mesh_maxNips = max ( mesh_maxNips , FE_Nips ( t ) )
mesh_maxNipNeighbors = max ( mesh_maxNipNeighbors , FE_NipNeighbors ( t ) )
mesh_maxNsubNodes = max ( mesh_maxNsubNodes , FE_NsubNodes ( t ) )
endif
enddo
endif
enddo
620 return
endsubroutine
2010-05-06 22:10:47 +05:30
!********************************************************************
! store x,y,z coordinates of all nodes in mesh
!
! allocate globals:
! _node
!********************************************************************
subroutine mesh_spectral_build_nodes ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 7
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
integer ( pInt ) a , b , c , n , i
real ( pReal ) x , y , z
logical gotResolution , gotDimension
integer ( pInt ) unit
character ( len = 64 ) tag
character ( len = 1024 ) line
2010-07-01 20:50:39 +05:30
allocate ( mesh_node ( 3 , mesh_Nnodes ) ) ; mesh_node = 0_pInt
2010-05-06 22:10:47 +05:30
a = 1_pInt
b = 1_pInt
c = 1_pInt
x = 1.0_pReal
y = 1.0_pReal
z = 1.0_pReal
gotResolution = . false .
gotDimension = . false .
rewind ( unit )
do
read ( unit , '(a1024)' , END = 100 ) line
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
pos = IO_stringPos ( line , maxNchunks )
select case ( IO_lc ( IO_StringValue ( line , pos , 1 ) ) )
case ( 'resolution' )
gotResolution = . true .
2010-05-10 20:24:59 +05:30
do i = 2 , 6 , 2
tag = IO_lc ( IO_stringValue ( line , pos , i ) )
select case ( tag )
case ( 'a' )
2010-10-01 16:12:15 +05:30
a = 1 + IO_intValue ( line , pos , i + 1 )
2010-05-10 20:24:59 +05:30
case ( 'b' )
2010-10-01 16:12:15 +05:30
b = 1 + IO_intValue ( line , pos , i + 1 )
2010-05-10 20:24:59 +05:30
case ( 'c' )
2010-10-01 16:12:15 +05:30
c = 1 + IO_intValue ( line , pos , i + 1 )
2010-05-10 20:24:59 +05:30
end select
enddo
2010-05-06 22:10:47 +05:30
case ( 'dimension' )
gotDimension = . true .
2010-05-10 20:24:59 +05:30
do i = 2 , 6 , 2
tag = IO_lc ( IO_stringValue ( line , pos , i ) )
select case ( tag )
case ( 'x' )
x = IO_floatValue ( line , pos , i + 1 )
case ( 'y' )
y = IO_floatValue ( line , pos , i + 1 )
case ( 'z' )
z = IO_floatValue ( line , pos , i + 1 )
end select
enddo
end select
2010-05-06 22:10:47 +05:30
if ( gotDimension . and . gotResolution ) exit
enddo
! --- sanity checks ---
2010-06-10 20:21:10 +05:30
if ( . not . gotDimension . or . . not . gotResolution ) call IO_error ( 42 )
if ( a < 2 . or . b < 2 . or . c < 2 ) call IO_error ( 43 )
if ( x < = 0.0_pReal . or . y < = 0.0_pReal . or . z < = 0.0_pReal ) call IO_error ( 44 )
2010-05-06 22:10:47 +05:30
forall ( n = 0 : mesh_Nnodes - 1 )
mesh_node ( 1 , n + 1 ) = x * dble ( mod ( n , a ) / ( a - 1.0_pReal ) )
mesh_node ( 2 , n + 1 ) = y * dble ( mod ( n / a , b ) / ( b - 1.0_pReal ) )
mesh_node ( 3 , n + 1 ) = z * dble ( mod ( n / a / b , c ) / ( c - 1.0_pReal ) )
end forall
100 return
endsubroutine
2009-10-12 21:31:49 +05:30
!********************************************************************
! store x,y,z coordinates of all nodes in mesh
!
! allocate globals:
! _node
!********************************************************************
subroutine mesh_marc_build_nodes ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , dimension ( 5 ) , parameter :: node_ends = ( / 0 , 10 , 30 , 50 , 70 / )
integer ( pInt ) , parameter :: maxNchunks = 1
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) unit , i , j , m
allocate ( mesh_node ( 3 , mesh_Nnodes ) ) ; mesh_node = 0_pInt
610 FORMAT ( A300 )
rewind ( unit )
do
read ( unit , 610 , END = 670 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == 'coordinates' ) then
read ( unit , 610 , END = 670 ) line ! skip crap line
do i = 1 , mesh_Nnodes
read ( unit , 610 , END = 670 ) line
m = mesh_FEasCP ( 'node' , IO_fixedIntValue ( line , node_ends , 1 ) )
forall ( j = 1 : 3 ) mesh_node ( j , m ) = IO_fixedNoEFloatValue ( line , node_ends , j + 1 )
enddo
exit
endif
enddo
670 return
endsubroutine
!********************************************************************
! store x,y,z coordinates of all nodes in mesh
!
! allocate globals:
! _node
!********************************************************************
subroutine mesh_abaqus_build_nodes ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 4
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) unit , i , j , m , count
logical inPart
allocate ( mesh_node ( 3 , mesh_Nnodes ) ) ; mesh_node = 0_pInt
610 FORMAT ( A300 )
inPart = . false .
rewind ( unit )
do
read ( unit , 610 , END = 670 ) line
pos = IO_stringPos ( line , maxNchunks )
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*part' ) inPart = . true .
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*end' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'part' ) inPart = . false .
2010-07-13 15:56:07 +05:30
if ( ( inPart . or . noPart ) . and . &
2009-10-12 21:31:49 +05:30
IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*node' . and . &
( IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'output' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'print' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'file' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'response' ) &
) then
count = IO_countDataLines ( unit ) ! how many nodes are defined here?
do i = 1 , count
backspace ( unit ) ! rewind to first entry
enddo
do i = 1 , count
read ( unit , 610 , END = 670 ) line
pos = IO_stringPos ( line , maxNchunks )
m = mesh_FEasCP ( 'node' , IO_intValue ( line , pos , 1 ) )
forall ( j = 1 : 3 ) mesh_node ( j , m ) = IO_floatValue ( line , pos , j + 1 )
enddo
endif
enddo
2010-07-13 15:56:07 +05:30
670 if ( size ( mesh_node , 2 ) / = mesh_Nnodes ) call IO_error ( 909 )
return
2009-10-12 21:31:49 +05:30
endsubroutine
2010-05-06 22:10:47 +05:30
!********************************************************************
! store FEid, type, mat, tex, and node list per element
!
! allocate globals:
! _element
!********************************************************************
subroutine mesh_spectral_build_elements ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 7
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
integer ( pInt ) a , b , c , e , i , homog
logical gotResolution , gotDimension , gotHomogenization
integer ( pInt ) unit
character ( len = 1024 ) line
a = 1_pInt
b = 1_pInt
c = 1_pInt
gotResolution = . false .
gotDimension = . false .
gotHomogenization = . false .
rewind ( unit )
do
read ( unit , '(a1024)' , END = 100 ) line
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
pos = IO_stringPos ( line , maxNchunks )
select case ( IO_lc ( IO_StringValue ( line , pos , 1 ) ) )
case ( 'dimension' )
gotDimension = . true .
case ( 'homogenization' )
gotHomogenization = . true .
2010-05-10 20:24:59 +05:30
homog = IO_intValue ( line , pos , 2 )
2010-05-06 22:10:47 +05:30
case ( 'resolution' )
gotResolution = . true .
2010-05-10 20:24:59 +05:30
do i = 2 , 6 , 2
select case ( IO_lc ( IO_stringValue ( line , pos , i ) ) )
case ( 'a' )
2010-10-01 16:12:15 +05:30
a = IO_intValue ( line , pos , i + 1 )
2010-05-10 20:24:59 +05:30
case ( 'b' )
2010-10-01 16:12:15 +05:30
b = IO_intValue ( line , pos , i + 1 )
2010-05-10 20:24:59 +05:30
case ( 'c' )
2010-10-01 16:12:15 +05:30
c = IO_intValue ( line , pos , i + 1 )
2010-05-10 20:24:59 +05:30
end select
enddo
end select
2010-05-06 22:10:47 +05:30
if ( gotDimension . and . gotHomogenization . and . gotResolution ) exit
enddo
100 allocate ( mesh_element ( 4 + mesh_maxNnodes , mesh_NcpElems ) ) ; mesh_element = 0_pInt
e = 0_pInt
do while ( e < mesh_NcpElems )
read ( unit , '(a1024)' , END = 110 ) line
if ( IO_isBlank ( line ) ) cycle ! skip empty lines
2010-08-04 05:17:00 +05:30
pos ( 1 : 1 + 2 * 1 ) = IO_stringPos ( line , 1 )
2010-05-06 22:10:47 +05:30
e = e + 1 ! valid element entry
2010-05-10 20:24:59 +05:30
mesh_element ( 1 , e ) = e ! FE id
mesh_element ( 2 , e ) = FE_mapElemtype ( 'C3D8R' ) ! elem type
mesh_element ( 3 , e ) = homog ! homogenization
mesh_element ( 4 , e ) = IO_IntValue ( line , pos , 1 ) ! microstructure
2010-07-13 15:56:07 +05:30
mesh_element ( 5 , e ) = e + ( e - 1 ) / a + ( e - 1 ) / a / b * ( a + 1 ) ! base node
2010-05-10 20:24:59 +05:30
mesh_element ( 6 , e ) = mesh_element ( 5 , e ) + 1
mesh_element ( 7 , e ) = mesh_element ( 5 , e ) + ( a + 1 ) + 1
mesh_element ( 8 , e ) = mesh_element ( 5 , e ) + ( a + 1 )
mesh_element ( 9 , e ) = mesh_element ( 5 , e ) + ( a + 1 ) * ( b + 1 ) ! second floor base node
mesh_element ( 10 , e ) = mesh_element ( 9 , e ) + 1
mesh_element ( 11 , e ) = mesh_element ( 9 , e ) + ( a + 1 ) + 1
mesh_element ( 12 , e ) = mesh_element ( 9 , e ) + ( a + 1 )
2010-07-01 20:50:39 +05:30
mesh_maxValStateVar ( 1 ) = max ( mesh_maxValStateVar ( 1 ) , mesh_element ( 3 , e ) ) !needed for statistics
mesh_maxValStateVar ( 2 ) = max ( mesh_maxValStateVar ( 2 ) , mesh_element ( 4 , e ) )
2010-05-06 22:10:47 +05:30
enddo
2010-07-01 20:50:39 +05:30
2010-05-06 22:10:47 +05:30
110 return
endsubroutine
2009-10-12 21:31:49 +05:30
!********************************************************************
! store FEid, type, mat, tex, and node list per element
!
! allocate globals:
! _element
!********************************************************************
subroutine mesh_marc_build_elements ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 66
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
character ( len = 300 ) line
integer ( pInt ) , dimension ( 1 + mesh_NcpElems ) :: contInts
integer ( pInt ) unit , i , j , sv , val , e
allocate ( mesh_element ( 4 + mesh_maxNnodes , mesh_NcpElems ) ) ; mesh_element = 0_pInt
610 FORMAT ( A300 )
rewind ( unit )
do
read ( unit , 610 , END = 620 ) line
2010-08-04 05:17:00 +05:30
pos ( 1 : 1 + 2 * 1 ) = IO_stringPos ( line , 1 )
2009-10-12 21:31:49 +05:30
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == 'connectivity' ) then
read ( unit , 610 , END = 620 ) line ! Garbage line
do i = 1 , mesh_Nelems
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks ) ! limit to 64 nodes max (plus ID, type)
e = mesh_FEasCP ( 'elem' , IO_intValue ( line , pos , 1 ) )
if ( e / = 0 ) then ! disregard non CP elems
2010-09-30 13:01:53 +05:30
mesh_element ( 1 , e ) = IO_IntValue ( line , pos , 1 ) ! FE id
mesh_element ( 2 , e ) = FE_mapElemtype ( IO_StringValue ( line , pos , 2 ) ) ! elem type
2009-10-12 21:31:49 +05:30
forall ( j = 1 : FE_Nnodes ( mesh_element ( 2 , e ) ) ) &
2010-09-30 13:01:53 +05:30
mesh_element ( j + 4 , e ) = IO_IntValue ( line , pos , j + 2 ) ! copy FE ids of nodes
2009-10-12 21:31:49 +05:30
call IO_skipChunks ( unit , FE_NoriginalNodes ( mesh_element ( 2 , e ) ) - ( pos ( 1 ) - 2 ) ) ! read on if FE_Nnodes exceeds node count present on current line
endif
enddo
exit
endif
enddo
620 rewind ( unit ) ! just in case "initial state" apears before "connectivity"
read ( unit , 610 , END = 620 ) line
do
2010-08-04 05:17:00 +05:30
pos ( 1 : 1 + 2 * 2 ) = IO_stringPos ( line , 2 )
2009-10-12 21:31:49 +05:30
if ( ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == 'initial' ) . and . &
( IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'state' ) ) then
if ( initialcondTableStyle == 2 ) read ( unit , 610 , END = 620 ) line ! read extra line for new style
read ( unit , 610 , END = 630 ) line ! read line with index of state var
2010-08-04 05:17:00 +05:30
pos ( 1 : 1 + 2 * 1 ) = IO_stringPos ( line , 1 )
2009-10-12 21:31:49 +05:30
sv = IO_IntValue ( line , pos , 1 ) ! figure state variable index
if ( ( sv == 2 ) . or . ( sv == 3 ) ) then ! only state vars 2 and 3 of interest
read ( unit , 610 , END = 620 ) line ! read line with value of state var
2010-08-04 05:17:00 +05:30
pos ( 1 : 1 + 2 * 1 ) = IO_stringPos ( line , 1 )
2009-10-12 21:31:49 +05:30
do while ( scan ( IO_stringValue ( line , pos , 1 ) , '+-' , back = . true . ) > 1 ) ! is noEfloat value?
val = NINT ( IO_fixedNoEFloatValue ( line , ( / 0 , 20 / ) , 1 ) ) ! state var's value
mesh_maxValStateVar ( sv - 1 ) = max ( val , mesh_maxValStateVar ( sv - 1 ) ) ! remember max val of homogenization and microstructure index
if ( initialcondTableStyle == 2 ) then
read ( unit , 610 , END = 630 ) line ! read extra line
read ( unit , 610 , END = 630 ) line ! read extra line
endif
contInts = IO_continousIntValues ( unit , mesh_Nelems , mesh_nameElemSet , mesh_mapElemSet , mesh_NelemSets ) ! get affected elements
do i = 1 , contInts ( 1 )
e = mesh_FEasCP ( 'elem' , contInts ( 1 + i ) )
mesh_element ( 1 + sv , e ) = val
enddo
if ( initialcondTableStyle == 0 ) read ( unit , 610 , END = 620 ) line ! ignore IP range for old table style
read ( unit , 610 , END = 630 ) line
2010-08-04 05:17:00 +05:30
pos ( 1 : 1 + 2 * 1 ) = IO_stringPos ( line , 1 )
2009-10-12 21:31:49 +05:30
enddo
endif
else
read ( unit , 610 , END = 630 ) line
endif
enddo
630 return
endsubroutine
!********************************************************************
! store FEid, type, mat, tex, and node list per element
!
! allocate globals:
! _element
!********************************************************************
subroutine mesh_abaqus_build_elements ( unit )
use prec , only : pInt
use IO
implicit none
integer ( pInt ) , parameter :: maxNchunks = 65
integer ( pInt ) , dimension ( 1 + 2 * maxNchunks ) :: pos
2011-03-23 21:50:12 +05:30
integer ( pInt ) unit , i , j , k , count , e , t , homog , micro
2009-10-12 21:31:49 +05:30
logical inPart , materialFound
character ( len = 64 ) materialName , elemSetName
character ( len = 300 ) line
allocate ( mesh_element ( 4 + mesh_maxNnodes , mesh_NcpElems ) ) ; mesh_element = 0_pInt
610 FORMAT ( A300 )
inPart = . false .
rewind ( unit )
do
read ( unit , 610 , END = 620 ) line
2010-08-04 05:17:00 +05:30
pos ( 1 : 1 + 2 * 2 ) = IO_stringPos ( line , 2 )
2009-10-12 21:31:49 +05:30
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*part' ) inPart = . true .
if ( IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*end' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) == 'part' ) inPart = . false .
2010-07-13 15:56:07 +05:30
if ( ( inPart . or . noPart ) . and . &
2009-10-12 21:31:49 +05:30
IO_lc ( IO_stringValue ( line , pos , 1 ) ) == '*element' . and . &
( IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'output' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'matrix' . and . &
IO_lc ( IO_stringValue ( line , pos , 2 ) ) / = 'response' ) &
) then
2010-07-13 15:56:07 +05:30
t = FE_mapElemtype ( IO_extractValue ( IO_lc ( IO_stringValue ( line , pos , 2 ) ) , 'type' ) ) ! remember elem type
if ( t == 0 ) call IO_error ( ID = 910 , ext_msg = 'mesh_abaqus_build_elements' )
2009-10-12 21:31:49 +05:30
count = IO_countDataLines ( unit )
do i = 1 , count
backspace ( unit )
enddo
do i = 1 , count
read ( unit , 610 , END = 620 ) line
pos = IO_stringPos ( line , maxNchunks ) ! limit to 64 nodes max
e = mesh_FEasCP ( 'elem' , IO_intValue ( line , pos , 1 ) )
if ( e / = 0 ) then ! disregard non CP elems
mesh_element ( 1 , e ) = IO_intValue ( line , pos , 1 ) ! FE id
mesh_element ( 2 , e ) = t ! elem type
forall ( j = 1 : FE_Nnodes ( t ) ) &
mesh_element ( 4 + j , e ) = IO_intValue ( line , pos , 1 + j ) ! copy FE ids of nodes to position 5:
call IO_skipChunks ( unit , FE_NoriginalNodes ( t ) - ( pos ( 1 ) - 1 ) ) ! read on (even multiple lines) if FE_NoriginalNodes exceeds required node count
endif
enddo
endif
enddo
620 rewind ( unit ) ! just in case "*material" definitions apear before "*element"
materialFound = . false .
do
read ( unit , 610 , END = 630 ) line
pos = IO_stringPos ( line , maxNchunks )
select case ( IO_lc ( IO_StringValue ( line , pos , 1 ) ) )
case ( '*material' )
materialName = IO_extractValue ( IO_lc ( IO_StringValue ( line , pos , 2 ) ) , 'name' ) ! extract name=value
2011-03-23 21:50:12 +05:30
materialFound = materialName / = '' ! valid name?
2009-10-12 21:31:49 +05:30
case ( '*user' )
if ( IO_lc ( IO_StringValue ( line , pos , 2 ) ) == 'material' . and . &
materialFound ) then
2011-03-23 21:50:12 +05:30
read ( unit , 610 , END = 630 ) line ! read homogenization and microstructure
pos ( 1 : 1 + 2 * 2 ) = IO_stringPos ( line , 2 )
homog = NINT ( IO_floatValue ( line , pos , 1 ) )
micro = NINT ( IO_floatValue ( line , pos , 2 ) )
do i = 1 , mesh_Nmaterials ! look thru material names
if ( materialName == mesh_nameMaterial ( i ) ) then ! found one
elemSetName = mesh_mapMaterial ( i ) ! take corresponding elemSet
do k = 1 , mesh_NelemSets ! look thru all elemSet definitions
if ( elemSetName == mesh_nameElemSet ( k ) ) then ! matched?
do j = 1 , mesh_mapElemSet ( 1 , k )
e = mesh_FEasCP ( 'elem' , mesh_mapElemSet ( 1 + j , k ) )
mesh_element ( 3 , e ) = homog ! store homogenization
mesh_element ( 4 , e ) = micro ! store microstructure
mesh_maxValStateVar ( 1 ) = max ( mesh_maxValStateVar ( 1 ) , homog )
mesh_maxValStateVar ( 2 ) = max ( mesh_maxValStateVar ( 2 ) , micro )
enddo
endif
enddo
endif
2009-10-12 21:31:49 +05:30
enddo
materialFound = . false .
endif
endselect
enddo
630 return
endsubroutine
!********************************************************************
! get maximum count of shared elements among cpElements and
! build list of elements shared by each node in mesh
!
! _maxNsharedElems
! _sharedElem
!********************************************************************
2011-02-16 21:53:08 +05:30
subroutine mesh_build_sharedElems ( )
use prec , only : pInt
implicit none
integer ( pint ) e , & ! element index
t , & ! element type
node , & ! CP node index
j , & ! node index per element
dim , & ! dimension index
nodeTwin ! node twin in the specified dimension
integer ( pInt ) , dimension ( mesh_Nnodes ) :: node_count
integer ( pInt ) , dimension ( : ) , allocatable :: node_seen
allocate ( node_seen ( maxval ( FE_Nnodes ) ) )
2011-03-23 21:50:12 +05:30
2011-02-16 21:53:08 +05:30
node_count = 0_pInt
do e = 1 , mesh_NcpElems
t = mesh_element ( 2 , e )
node_seen = 0_pInt ! reset node duplicates
do j = 1 , FE_Nnodes ( t ) ! check each node of element
node = mesh_FEasCP ( 'node' , mesh_element ( 4 + j , e ) )
if ( all ( node_seen / = node ) ) then
node_count ( node ) = node_count ( node ) + 1_pInt ! if FE node not yet encountered -> count it
do dim = 1 , 3 ! check in each dimension...
nodeTwin = mesh_nodeTwins ( dim , node )
if ( nodeTwin > 0 ) & ! if i am a twin of some node...
node_count ( nodeTwin ) = node_count ( nodeTwin ) + 1_pInt ! -> count me again for the twin node
enddo
endif
node_seen ( j ) = node ! remember this node to be counted already
enddo
enddo
mesh_maxNsharedElems = maxval ( node_count ) ! most shared node
allocate ( mesh_sharedElem ( 1 + mesh_maxNsharedElems , mesh_Nnodes ) )
mesh_sharedElem = 0_pInt
do e = 1 , mesh_NcpElems
t = mesh_element ( 2 , e )
node_seen = 0_pInt
do j = 1 , FE_Nnodes ( t )
node = mesh_FEasCP ( 'node' , mesh_element ( 4 + j , e ) )
if ( all ( node_seen / = node ) ) then
mesh_sharedElem ( 1 , node ) = mesh_sharedElem ( 1 , node ) + 1_pInt ! count for each node the connected elements
mesh_sharedElem ( mesh_sharedElem ( 1 , node ) + 1 , node ) = e ! store the respective element id
do dim = 1 , 3 ! check in each dimension...
nodeTwin = mesh_nodeTwins ( dim , node )
if ( nodeTwin > 0 ) then ! if i am a twin of some node...
mesh_sharedElem ( 1 , nodeTwin ) = mesh_sharedElem ( 1 , nodeTwin ) + 1_pInt ! ...count me again for the twin
mesh_sharedElem ( mesh_sharedElem ( 1 , nodeTwin ) + 1 , nodeTwin ) = e ! store the respective element id
endif
enddo
endif
node_seen ( j ) = node
enddo
enddo
2009-10-12 21:31:49 +05:30
2011-02-16 21:53:08 +05:30
deallocate ( node_seen )
2009-10-12 21:31:49 +05:30
2011-02-16 21:53:08 +05:30
endsubroutine
2009-10-12 21:31:49 +05:30
!***********************************************************
! build up of IP neighborhood
!
! allocate globals
! _ipNeighborhood
!***********************************************************
2011-02-16 21:53:08 +05:30
subroutine mesh_build_ipNeighborhood ( )
use prec , only : pInt
implicit none
integer ( pInt ) myElem , & ! my CP element index
myIP , &
myType , & ! my element type
myFace , &
neighbor , & ! neighor index
neighboringIPkey , & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element)
candidateIP , &
neighboringType , & ! element type of neighbor
NlinkedNodes , & ! number of linked nodes
twin_of_linkedNode , & ! node twin of a specific linkedNode
NmatchingNodes , & ! number of matching nodes
dir , & ! direction of periodicity
matchingElem , & ! CP elem number of matching element
matchingFace , & ! face ID of matching element
2011-04-13 19:46:22 +05:30
a , anchor
2011-02-16 21:53:08 +05:30
integer ( pInt ) , dimension ( FE_maxmaxNnodesAtIP ) :: &
linkedNodes , &
matchingNodes
logical checkTwins
allocate ( mesh_ipNeighborhood ( 2 , mesh_maxNipNeighbors , mesh_maxNips , mesh_NcpElems ) )
mesh_ipNeighborhood = 0_pInt
linkedNodes = 0_pInt
do myElem = 1 , mesh_NcpElems ! loop over cpElems
myType = mesh_element ( 2 , myElem ) ! get elemType
do myIP = 1 , FE_Nips ( myType ) ! loop over IPs of elem
do neighbor = 1 , FE_NipNeighbors ( myType ) ! loop over neighbors of IP
neighboringIPkey = FE_ipNeighbor ( neighbor , myIP , myType )
!*** if the key is positive, the neighbor is inside the element
!*** that means, we have already found our neighboring IP
if ( neighboringIPkey > 0 ) then
mesh_ipNeighborhood ( 1 , neighbor , myIP , myElem ) = myElem
mesh_ipNeighborhood ( 2 , neighbor , myIP , myElem ) = neighboringIPkey
!*** if the key is negative, the neighbor resides in a neighboring element
!*** that means, we have to look through the face indicated by the key and see which element is behind that face
elseif ( neighboringIPkey < 0 ) then ! neighboring element's IP
myFace = - neighboringIPkey
call mesh_faceMatch ( myElem , myFace , matchingElem , matchingFace ) ! get face and CP elem id of face match
if ( matchingElem > 0_pInt ) then ! found match?
neighboringType = mesh_element ( 2 , matchingElem )
!*** trivial solution if neighbor has only one IP
if ( FE_Nips ( neighboringType ) == 1_pInt ) then
mesh_ipNeighborhood ( 1 , neighbor , myIP , myElem ) = matchingElem
mesh_ipNeighborhood ( 2 , neighbor , myIP , myElem ) = 1_pInt
cycle
endif
2010-05-10 20:24:59 +05:30
2011-02-16 21:53:08 +05:30
!*** find those nodes which build the link to the neighbor
NlinkedNodes = 0_pInt
linkedNodes = 0_pInt
do a = 1 , FE_maxNnodesAtIP ( myType ) ! figure my anchor nodes on connecting face
anchor = FE_nodesAtIP ( a , myIP , myType )
if ( anchor / = 0_pInt ) then ! valid anchor node
if ( any ( FE_nodeOnFace ( : , myFace , myType ) == anchor ) ) then ! ip anchor sits on face?
NlinkedNodes = NlinkedNodes + 1_pInt
linkedNodes ( NlinkedNodes ) = mesh_element ( 4 + anchor , myElem ) ! FE id of anchor node
else ! something went wrong with the linkage, since not all anchors sit on my face
NlinkedNodes = 0_pInt
linkedNodes = 0_pInt
exit
endif
endif
enddo
!*** loop through the ips of my neighbor
!*** and try to find an ip with matching nodes
!*** also try to match with node twins
checkCandidateIP : do candidateIP = 1 , FE_Nips ( neighboringType )
NmatchingNodes = 0_pInt
matchingNodes = 0_pInt
do a = 1 , FE_maxNnodesAtIP ( neighboringType ) ! check each anchor node of that ip
anchor = FE_nodesAtIP ( a , candidateIP , neighboringType )
if ( anchor / = 0_pInt ) then ! valid anchor node
if ( any ( FE_nodeOnFace ( : , matchingFace , neighboringType ) == anchor ) ) then ! sits on matching face?
NmatchingNodes = NmatchingNodes + 1_pInt
matchingNodes ( NmatchingNodes ) = mesh_element ( 4 + anchor , matchingElem ) ! FE id of neighbor's anchor node
else ! no matching, because not all nodes sit on the matching face
NmatchingNodes = 0_pInt
matchingNodes = 0_pInt
exit
endif
endif
enddo
if ( NmatchingNodes / = NlinkedNodes ) & ! this ip has wrong count of anchors on face
cycle checkCandidateIP
!*** check "normal" nodes whether they match or not
checkTwins = . false .
do a = 1 , NlinkedNodes
if ( all ( matchingNodes / = linkedNodes ( a ) ) ) then ! this linkedNode does not match any matchingNode
checkTwins = . true .
exit ! no need to search further
endif
enddo
!*** if no match found, then also check node twins
if ( checkTwins ) then
2011-02-24 14:56:30 +05:30
dir = maxloc ( abs ( mesh_ipAreaNormal ( 1 : 3 , neighbor , myIP , myElem ) ) , 1 ) ! check for twins only in direction of the surface normal
do a = 1 , NlinkedNodes
twin_of_linkedNode = mesh_nodeTwins ( dir , linkedNodes ( a ) )
if ( twin_of_linkedNode == 0_pInt & ! twin of linkedNode does not exist...
. or . all ( matchingNodes / = twin_of_linkedNode ) ) then ! ... or it does not match any matchingNode
cycle checkCandidateIP ! ... so check next candidateIP
endif
enddo
2011-02-16 21:53:08 +05:30
endif
!*** we found a match !!!
mesh_ipNeighborhood ( 1 , neighbor , myIP , myElem ) = matchingElem
mesh_ipNeighborhood ( 2 , neighbor , myIP , myElem ) = candidateIP
2011-02-24 14:56:30 +05:30
exit checkCandidateIP
2011-02-16 21:53:08 +05:30
enddo checkCandidateIP
endif ! end of valid external matching
endif ! end of internal/external matching
enddo
enddo
enddo
2009-01-20 00:12:31 +05:30
2011-02-16 21:53:08 +05:30
endsubroutine
2009-01-20 00:12:31 +05:30
2009-01-16 23:06:37 +05:30
!***********************************************************
! assignment of coordinates for subnodes in each cp element
!
! allocate globals
! _subNodeCoord
!***********************************************************
2009-06-15 18:41:21 +05:30
subroutine mesh_build_subNodeCoords ( )
2009-01-16 23:06:37 +05:30
use prec , only : pInt , pReal
implicit none
integer ( pInt ) e , t , n , p
2009-10-12 21:31:49 +05:30
2009-01-16 23:06:37 +05:30
allocate ( mesh_subNodeCoord ( 3 , mesh_maxNnodes + mesh_maxNsubNodes , mesh_NcpElems ) ) ; mesh_subNodeCoord = 0.0_pReal
do e = 1 , mesh_NcpElems ! loop over cpElems
t = mesh_element ( 2 , e ) ! get elemType
do n = 1 , FE_Nnodes ( t )
mesh_subNodeCoord ( : , n , e ) = mesh_node ( : , mesh_FEasCP ( 'node' , mesh_element ( 4 + n , e ) ) ) ! loop over nodes of this element type
enddo
2009-01-20 00:12:31 +05:30
do n = 1 , FE_NsubNodes ( t ) ! now for the true subnodes
2009-04-03 12:33:25 +05:30
do p = 1 , FE_Nips ( t ) ! loop through possible parent nodes
2009-04-02 18:30:51 +05:30
if ( FE_subNodeParent ( p , n , t ) > 0 ) & ! valid parent node
2009-01-16 23:06:37 +05:30
mesh_subNodeCoord ( : , n + FE_Nnodes ( t ) , e ) = &
2009-04-02 18:30:51 +05:30
mesh_subNodeCoord ( : , n + FE_Nnodes ( t ) , e ) + &
mesh_node ( : , mesh_FEasCP ( 'node' , mesh_element ( 4 + FE_subNodeParent ( p , n , t ) , e ) ) ) ! add up parents
enddo
2009-01-16 23:06:37 +05:30
mesh_subNodeCoord ( : , n + FE_Nnodes ( t ) , e ) = mesh_subNodeCoord ( : , n + FE_Nnodes ( t ) , e ) / count ( FE_subNodeParent ( : , n , t ) > 0 )
2009-01-20 00:12:31 +05:30
enddo
2009-01-16 23:06:37 +05:30
enddo
return
2009-06-15 18:41:21 +05:30
endsubroutine
2009-01-16 23:06:37 +05:30
!***********************************************************
! calculation of IP volume
!
! allocate globals
! _ipVolume
!***********************************************************
2009-06-15 18:41:21 +05:30
subroutine mesh_build_ipVolumes ( )
2009-01-16 23:06:37 +05:30
2011-02-25 18:19:18 +05:30
use prec , only : pInt , tol_gravityNodePos
2009-01-16 23:06:37 +05:30
use math , only : math_volTetrahedron
implicit none
2009-04-03 12:33:25 +05:30
integer ( pInt ) e , f , t , i , j , k , n
2009-01-20 00:12:31 +05:30
integer ( pInt ) , parameter :: Ntriangles = FE_NipFaceNodes - 2 ! each interface is made up of this many triangles
2009-12-22 18:53:20 +05:30
logical ( pInt ) , dimension ( mesh_maxNnodes + mesh_maxNsubNodes ) :: gravityNode ! flagList to find subnodes determining center of grav
2009-01-16 23:06:37 +05:30
real ( pReal ) , dimension ( 3 , mesh_maxNnodes + mesh_maxNsubNodes ) :: gravityNodePos ! coordinates of subnodes determining center of grav
2009-10-12 21:31:49 +05:30
real ( pReal ) , dimension ( 3 , FE_NipFaceNodes ) :: nPos ! coordinates of nodes on IP face
2009-01-20 00:12:31 +05:30
real ( pReal ) , dimension ( Ntriangles , FE_NipFaceNodes ) :: volume ! volumes of possible tetrahedra
2009-01-16 23:06:37 +05:30
real ( pReal ) , dimension ( 3 ) :: centerOfGravity
2009-08-11 22:01:57 +05:30
allocate ( mesh_ipVolume ( mesh_maxNips , mesh_NcpElems ) ) ; mesh_ipVolume = 0.0_pReal
allocate ( mesh_ipCenterOfGravity ( 3 , mesh_maxNips , mesh_NcpElems ) ) ; mesh_ipCenterOfGravity = 0.0_pReal
2009-10-12 21:31:49 +05:30
do e = 1 , mesh_NcpElems ! loop over cpElems
t = mesh_element ( 2 , e ) ! get elemType
do i = 1 , FE_Nips ( t ) ! loop over IPs of elem
2009-12-22 18:53:20 +05:30
gravityNode = . false . ! reset flagList
2009-10-12 21:31:49 +05:30
gravityNodePos = 0.0_pReal ! reset coordinates
do f = 1 , FE_NipNeighbors ( t ) ! loop over interfaces of IP
do n = 1 , FE_NipFaceNodes ! loop over nodes on interface
2009-12-22 18:53:20 +05:30
gravityNode ( FE_subNodeOnIPFace ( n , f , i , t ) ) = . true .
2009-01-16 23:06:37 +05:30
gravityNodePos ( : , FE_subNodeOnIPFace ( n , f , i , t ) ) = mesh_subNodeCoord ( : , FE_subNodeOnIPFace ( n , f , i , t ) , e )
2009-06-15 18:41:21 +05:30
enddo
enddo
2009-12-22 18:53:20 +05:30
2009-10-12 21:31:49 +05:30
do j = 1 , mesh_maxNnodes + mesh_maxNsubNodes - 1 ! walk through entire flagList except last
2009-12-22 18:53:20 +05:30
if ( gravityNode ( j ) ) then ! valid node index
2009-10-12 21:31:49 +05:30
do k = j + 1 , mesh_maxNnodes + mesh_maxNsubNodes ! walk through remainder of list
2011-02-25 18:19:18 +05:30
if ( gravityNode ( k ) . and . all ( abs ( gravityNodePos ( : , j ) - gravityNodePos ( : , k ) ) < tol_gravityNodePos ) ) then ! found duplicate
2009-12-22 18:53:20 +05:30
gravityNode ( j ) = . false . ! delete first instance
2009-04-02 18:30:51 +05:30
gravityNodePos ( : , j ) = 0.0_pReal
2009-10-12 21:31:49 +05:30
exit ! continue with next suspect
2009-06-15 18:41:21 +05:30
endif
enddo
endif
enddo
2009-12-22 18:53:20 +05:30
centerOfGravity = sum ( gravityNodePos , 2 ) / count ( gravityNode )
2009-10-12 21:31:49 +05:30
2009-01-20 00:12:31 +05:30
do f = 1 , FE_NipNeighbors ( t ) ! loop over interfaces of IP and add tetrahedra which connect to CoG
2009-04-02 18:30:51 +05:30
forall ( n = 1 : FE_NipFaceNodes ) nPos ( : , n ) = mesh_subNodeCoord ( : , FE_subNodeOnIPFace ( n , f , i , t ) , e )
2009-01-20 00:12:31 +05:30
forall ( n = 1 : FE_NipFaceNodes , j = 1 : Ntriangles ) & ! start at each interface node and build valid triangles to cover interface
volume ( j , n ) = math_volTetrahedron ( nPos ( : , n ) , & ! calc volume of respective tetrahedron to CoG
2011-04-06 14:05:37 +05:30
nPos ( : , 1 + mod ( n - 1 + j , FE_NipFaceNodes ) ) , & ! start at offset j
nPos ( : , 1 + mod ( n - 1 + j + 1 , FE_NipFaceNodes ) ) , & ! and take j's neighbor
2009-01-20 00:12:31 +05:30
centerOfGravity )
mesh_ipVolume ( i , e ) = mesh_ipVolume ( i , e ) + sum ( volume ) ! add contribution from this interface
2009-06-15 18:41:21 +05:30
enddo
2009-01-20 00:12:31 +05:30
mesh_ipVolume ( i , e ) = mesh_ipVolume ( i , e ) / FE_NipFaceNodes ! renormalize with interfaceNodeNum due to loop over them
2009-08-11 22:01:57 +05:30
mesh_ipCenterOfGravity ( : , i , e ) = centerOfGravity
2009-06-15 18:41:21 +05:30
enddo
enddo
2009-01-16 23:06:37 +05:30
return
2009-06-15 18:41:21 +05:30
endsubroutine
2009-01-16 23:06:37 +05:30
!***********************************************************
2009-03-04 17:18:54 +05:30
! calculation of IP interface areas
2009-01-16 23:06:37 +05:30
!
! allocate globals
2009-03-04 17:18:54 +05:30
! _ipArea, _ipAreaNormal
2009-01-16 23:06:37 +05:30
!***********************************************************
2009-06-15 18:41:21 +05:30
subroutine mesh_build_ipAreas ( )
2009-01-16 23:06:37 +05:30
use prec , only : pInt , pReal
use math
implicit none
2009-03-05 19:48:50 +05:30
integer ( pInt ) e , f , t , i , j , n
2009-10-12 21:31:49 +05:30
integer ( pInt ) , parameter :: Ntriangles = FE_NipFaceNodes - 2 ! each interface is made up of this many triangles
real ( pReal ) , dimension ( 3 , FE_NipFaceNodes ) :: nPos ! coordinates of nodes on IP face
2009-01-20 00:12:31 +05:30
real ( pReal ) , dimension ( 3 , Ntriangles , FE_NipFaceNodes ) :: normal
real ( pReal ) , dimension ( Ntriangles , FE_NipFaceNodes ) :: area
2009-01-16 23:06:37 +05:30
2009-01-20 00:12:31 +05:30
allocate ( mesh_ipArea ( mesh_maxNipNeighbors , mesh_maxNips , mesh_NcpElems ) ) ; mesh_ipArea = 0.0_pReal
2009-01-16 23:06:37 +05:30
allocate ( mesh_ipAreaNormal ( 3 , mesh_maxNipNeighbors , mesh_maxNips , mesh_NcpElems ) ) ; mesh_ipAreaNormal = 0.0_pReal
2009-10-12 21:31:49 +05:30
do e = 1 , mesh_NcpElems ! loop over cpElems
t = mesh_element ( 2 , e ) ! get elemType
do i = 1 , FE_Nips ( t ) ! loop over IPs of elem
do f = 1 , FE_NipNeighbors ( t ) ! loop over interfaces of IP
2010-05-10 20:24:59 +05:30
forall ( n = 1 : FE_NipFaceNodes ) nPos ( : , n ) = mesh_subNodeCoord ( : , FE_subNodeOnIPFace ( n , f , i , t ) , e )
2009-10-12 21:31:49 +05:30
forall ( n = 1 : FE_NipFaceNodes , j = 1 : Ntriangles ) ! start at each interface node and build valid triangles to cover interface
2009-01-20 00:12:31 +05:30
normal ( : , j , n ) = math_vectorproduct ( nPos ( : , 1 + mod ( n + j - 1 , FE_NipFaceNodes ) ) - nPos ( : , n ) , & ! calc their normal vectors
nPos ( : , 1 + mod ( n + j - 0 , FE_NipFaceNodes ) ) - nPos ( : , n ) )
2011-02-25 14:55:53 +05:30
area ( j , n ) = sqrt ( sum ( normal ( : , j , n ) * normal ( : , j , n ) ) ) ! and area
2009-01-20 00:12:31 +05:30
end forall
2010-05-10 20:24:59 +05:30
forall ( n = 1 : FE_NipFaceNodes , j = 1 : Ntriangles , area ( j , n ) > 0.0_pReal ) &
normal ( : , j , n ) = normal ( : , j , n ) / area ( j , n ) ! make unit normal
2009-08-11 22:01:57 +05:30
2009-10-12 21:31:49 +05:30
mesh_ipArea ( f , i , e ) = sum ( area ) / ( FE_NipFaceNodes * 2.0_pReal ) ! area of parallelograms instead of triangles
2010-05-10 20:24:59 +05:30
mesh_ipAreaNormal ( : , f , i , e ) = sum ( sum ( normal , 3 ) , 2 ) / count ( area > 0.0_pReal ) ! average of all valid normals
2009-01-16 23:06:37 +05:30
enddo
enddo
enddo
return
2007-04-10 16:52:53 +05:30
2009-06-15 18:41:21 +05:30
endsubroutine
2009-01-16 23:06:37 +05:30
2011-02-16 21:53:08 +05:30
!***********************************************************
! assignment of twin nodes for each cp node
!
! allocate globals
! _nodeTwins
!***********************************************************
subroutine mesh_build_nodeTwins ( )
use prec , only : pInt , pReal
implicit none
integer ( pInt ) dir , & ! direction of periodicity
node , &
minimumNode , &
maximumNode , &
n1 , &
n2
integer ( pInt ) , dimension ( mesh_Nnodes + 1 ) :: minimumNodes , maximumNodes ! list of surface nodes (minimum and maximum coordinate value) with first entry giving the number of nodes
real ( pReal ) minCoord , maxCoord , & ! extreme positions in one dimension
tolerance ! tolerance below which positions are assumed identical
real ( pReal ) , dimension ( 3 ) :: distance ! distance between two nodes in all three coordinates
logical , dimension ( mesh_Nnodes ) :: node_seen
allocate ( mesh_nodeTwins ( 3 , mesh_Nnodes ) )
mesh_nodeTwins = 0_pInt
tolerance = 0.001_pReal * minval ( mesh_ipVolume ) ** 0.333_pReal
do dir = 1 , 3 ! check periodicity in directions of x,y,z
if ( mesh_periodicSurface ( dir ) ) then ! only if periodicity is requested
!*** find out which nodes sit on the surface
!*** and have a minimum or maximum position in this dimension
minimumNodes = 0_pInt
maximumNodes = 0_pInt
minCoord = minval ( mesh_node ( dir , : ) )
maxCoord = maxval ( mesh_node ( dir , : ) )
do node = 1 , mesh_Nnodes ! loop through all nodes and find surface nodes
if ( abs ( mesh_node ( dir , node ) - minCoord ) < = tolerance ) then
minimumNodes ( 1 ) = minimumNodes ( 1 ) + 1_pInt
minimumNodes ( minimumNodes ( 1 ) + 1 ) = node
elseif ( abs ( mesh_node ( dir , node ) - maxCoord ) < = tolerance ) then
maximumNodes ( 1 ) = maximumNodes ( 1 ) + 1_pInt
maximumNodes ( maximumNodes ( 1 ) + 1 ) = node
endif
enddo
!*** find the corresponding node on the other side with the same position in this dimension
node_seen = . false .
do n1 = 1 , minimumNodes ( 1 )
minimumNode = minimumNodes ( n1 + 1 )
if ( node_seen ( minimumNode ) ) &
cycle
do n2 = 1 , maximumNodes ( 1 )
maximumNode = maximumNodes ( n2 + 1 )
distance = abs ( mesh_node ( : , minimumNode ) - mesh_node ( : , maximumNode ) )
if ( sum ( distance ) - distance ( dir ) < = tolerance ) then ! minimum possible distance (within tolerance)
mesh_nodeTwins ( dir , minimumNode ) = maximumNode
mesh_nodeTwins ( dir , maximumNode ) = minimumNode
node_seen ( maximumNode ) = . true . ! remember this node, we don't have to look for his partner again
exit
endif
enddo
enddo
endif
enddo
endsubroutine
2007-10-24 14:30:42 +05:30
!***********************************************************
! write statistics regarding input file parsing
! to the output file
!
!***********************************************************
2011-02-16 21:53:08 +05:30
subroutine mesh_tell_statistics ( )
2009-01-20 00:12:31 +05:30
2011-02-16 21:53:08 +05:30
use prec , only : pInt
use math , only : math_range
use IO , only : IO_error
2011-03-21 16:01:17 +05:30
use debug , only : debug_verbosity , &
debug_e , &
debug_i , &
debug_selectiveDebugger
2009-01-20 00:12:31 +05:30
2011-02-16 21:53:08 +05:30
implicit none
2009-01-20 00:12:31 +05:30
2011-02-16 21:53:08 +05:30
integer ( pInt ) , dimension ( : , : ) , allocatable :: mesh_HomogMicro
character ( len = 64 ) fmt
2009-01-20 00:12:31 +05:30
2011-02-16 21:53:08 +05:30
integer ( pInt ) i , e , n , f , t
2008-06-17 02:19:48 +05:30
2011-02-16 21:53:08 +05:30
if ( mesh_maxValStateVar ( 1 ) < 1_pInt ) call IO_error ( 110 ) ! no homogenization specified
if ( mesh_maxValStateVar ( 2 ) < 1_pInt ) call IO_error ( 120 ) ! no microstructure specified
allocate ( mesh_HomogMicro ( mesh_maxValStateVar ( 1 ) , mesh_maxValStateVar ( 2 ) ) ) ; mesh_HomogMicro = 0_pInt
do e = 1 , mesh_NcpElems
if ( mesh_element ( 3 , e ) < 1_pInt ) call IO_error ( 110 , e ) ! no homogenization specified
if ( mesh_element ( 4 , e ) < 1_pInt ) call IO_error ( 120 , e ) ! no homogenization specified
mesh_HomogMicro ( mesh_element ( 3 , e ) , mesh_element ( 4 , e ) ) = &
mesh_HomogMicro ( mesh_element ( 3 , e ) , mesh_element ( 4 , e ) ) + 1 ! count combinations of homogenization and microstructure
enddo
2010-09-07 14:36:02 +05:30
2011-03-21 16:01:17 +05:30
if ( debug_verbosity > 0 ) then
!$OMP CRITICAL (write2out)
write ( 6 , * )
write ( 6 , * ) "Input Parser: STATISTICS"
write ( 6 , * )
write ( 6 , * ) mesh_Nelems , " : total number of elements in mesh"
write ( 6 , * ) mesh_NcpElems , " : total number of CP elements in mesh"
write ( 6 , * ) mesh_Nnodes , " : total number of nodes in mesh"
write ( 6 , * ) mesh_maxNnodes , " : max number of nodes in any CP element"
write ( 6 , * ) mesh_maxNips , " : max number of IPs in any CP element"
write ( 6 , * ) mesh_maxNipNeighbors , " : max number of IP neighbors in any CP element"
write ( 6 , * ) mesh_maxNsubNodes , " : max number of (additional) subnodes in any CP element"
write ( 6 , * ) mesh_maxNsharedElems , " : max number of CP elements sharing a node"
write ( 6 , * )
write ( 6 , * ) "Input Parser: HOMOGENIZATION/MICROSTRUCTURE"
write ( 6 , * )
write ( 6 , * ) mesh_maxValStateVar ( 1 ) , " : maximum homogenization index"
write ( 6 , * ) mesh_maxValStateVar ( 2 ) , " : maximum microstructure index"
write ( 6 , * )
write ( fmt , "(a,i5,a)" ) "(9(x),a2,x," , mesh_maxValStateVar ( 2 ) , "(i8))"
write ( 6 , fmt ) "+-" , math_range ( mesh_maxValStateVar ( 2 ) )
write ( fmt , "(a,i5,a)" ) "(i8,x,a2,x," , mesh_maxValStateVar ( 2 ) , "(i8))"
do i = 1 , mesh_maxValStateVar ( 1 ) ! loop over all (possibly assigned) homogenizations
write ( 6 , fmt ) i , "| " , mesh_HomogMicro ( i , : ) ! loop over all (possibly assigned) microstrcutures
enddo
write ( 6 , * )
write ( 6 , * ) "Input Parser: ADDITIONAL MPIE OPTIONS"
write ( 6 , * )
write ( 6 , * ) "periodic surface : " , mesh_periodicSurface
write ( 6 , * )
call flush ( 6 )
!$OMP END CRITICAL (write2out)
endif
if ( debug_verbosity > 1 ) then
2010-09-07 14:36:02 +05:30
!$OMP CRITICAL (write2out)
2011-02-16 21:53:08 +05:30
write ( 6 , * )
write ( 6 , * ) "Input Parser: SUBNODE COORDINATES"
write ( 6 , * )
2011-05-11 22:08:45 +05:30
write ( 6 , '(a8,x,a5,x,a15,x,a15,x,a20,3(x,a12))' ) 'elem' , 'IP' , 'IP neighbor' , 'IPFaceNodes' , 'subNodeOnIPFace' , 'x' , 'y' , 'z'
2011-02-16 21:53:08 +05:30
do e = 1 , mesh_NcpElems ! loop over cpElems
2011-03-21 16:01:17 +05:30
if ( debug_selectiveDebugger . and . debug_e / = e ) cycle
2011-02-16 21:53:08 +05:30
t = mesh_element ( 2 , e ) ! get elemType
do i = 1 , FE_Nips ( t ) ! loop over IPs of elem
2011-03-21 16:01:17 +05:30
if ( debug_selectiveDebugger . and . debug_i / = i ) cycle
2011-02-16 21:53:08 +05:30
do f = 1 , FE_NipNeighbors ( t ) ! loop over interfaces of IP
do n = 1 , FE_NipFaceNodes ! loop over nodes on interface
2011-05-11 22:08:45 +05:30
write ( 6 , '(i8,x,i5,x,i15,x,i15,x,i20,3(x,f12.8))' ) e , i , f , n , FE_subNodeOnIPFace ( n , f , i , t ) , &
2011-02-16 21:53:08 +05:30
mesh_subNodeCoord ( 1 , FE_subNodeOnIPFace ( n , f , i , t ) , e ) , &
mesh_subNodeCoord ( 2 , FE_subNodeOnIPFace ( n , f , i , t ) , e ) , &
mesh_subNodeCoord ( 3 , FE_subNodeOnIPFace ( n , f , i , t ) , e )
enddo
enddo
enddo
enddo
write ( 6 , * )
write ( 6 , * ) 'Input Parser: IP COORDINATES'
2011-05-11 22:08:45 +05:30
write ( 6 , '(a8,x,a5,3(x,a12))' ) 'elem' , 'IP' , 'x' , 'y' , 'z'
2011-02-16 21:53:08 +05:30
do e = 1 , mesh_NcpElems
2011-03-21 16:01:17 +05:30
if ( debug_selectiveDebugger . and . debug_e / = e ) cycle
2011-02-16 21:53:08 +05:30
do i = 1 , FE_Nips ( mesh_element ( 2 , e ) )
2011-03-21 16:01:17 +05:30
if ( debug_selectiveDebugger . and . debug_i / = i ) cycle
2011-05-11 22:08:45 +05:30
write ( 6 , '(i8,x,i5,3(x,f12.8))' ) e , i , mesh_ipCenterOfGravity ( : , i , e )
2011-02-16 21:53:08 +05:30
enddo
enddo
write ( 6 , * )
2010-09-07 14:36:02 +05:30
write ( 6 , * ) "Input Parser: ELEMENT VOLUME"
write ( 6 , * )
write ( 6 , "(a13,x,e15.8)" ) "total volume" , sum ( mesh_ipVolume )
write ( 6 , * )
2011-05-11 22:08:45 +05:30
write ( 6 , "(a8,x,a5,x,a15,x,a5,x,a15,x,a16)" ) "elem" , "IP" , "volume" , "face" , "area" , "-- normal --"
2010-09-07 14:36:02 +05:30
do e = 1 , mesh_NcpElems
2011-03-21 16:01:17 +05:30
if ( debug_selectiveDebugger . and . debug_e / = e ) cycle
2010-09-07 14:36:02 +05:30
do i = 1 , FE_Nips ( mesh_element ( 2 , e ) )
2011-03-21 16:01:17 +05:30
if ( debug_selectiveDebugger . and . debug_i / = i ) cycle
2011-05-11 22:08:45 +05:30
write ( 6 , "(i8,x,i5,x,e15.8)" ) e , i , mesh_IPvolume ( i , e )
2010-09-07 14:36:02 +05:30
do f = 1 , FE_NipNeighbors ( mesh_element ( 2 , e ) )
write ( 6 , "(i33,x,e15.8,x,3(f6.3,x))" ) f , mesh_ipArea ( f , i , e ) , mesh_ipAreaNormal ( : , f , i , e )
enddo
enddo
enddo
write ( 6 , * )
2011-02-16 21:53:08 +05:30
write ( 6 , * ) "Input Parser: NODE TWINS"
write ( 6 , * )
write ( 6 , '(a6,3(3(x),a6))' ) ' node' , 'twin_x' , 'twin_y' , 'twin_z'
do n = 1 , mesh_Nnodes ! loop over cpNodes
2011-03-21 16:01:17 +05:30
if ( debug_e < = mesh_NcpElems ) then
if ( any ( mesh_element ( 5 : , debug_e ) == n ) ) then
write ( 6 , '(i6,3(3(x),i6))' ) n , mesh_nodeTwins ( 1 : 3 , n )
endif
endif
2011-02-16 21:53:08 +05:30
enddo
write ( 6 , * )
write ( 6 , * ) "Input Parser: IP NEIGHBORHOOD"
write ( 6 , * )
2011-05-11 22:08:45 +05:30
write ( 6 , "(a8,x,a10,x,a10,x,a3,x,a13,x,a13)" ) "elem" , "IP" , "neighbor" , "" , "elemNeighbor" , "ipNeighbor"
2011-02-16 21:53:08 +05:30
do e = 1 , mesh_NcpElems ! loop over cpElems
2011-03-21 16:01:17 +05:30
if ( debug_selectiveDebugger . and . debug_e / = e ) cycle
2011-02-16 21:53:08 +05:30
t = mesh_element ( 2 , e ) ! get elemType
do i = 1 , FE_Nips ( t ) ! loop over IPs of elem
2011-03-21 16:01:17 +05:30
if ( debug_selectiveDebugger . and . debug_i / = i ) cycle
2011-02-16 21:53:08 +05:30
do n = 1 , FE_NipNeighbors ( t ) ! loop over neighbors of IP
2011-05-11 22:08:45 +05:30
write ( 6 , "(i8,x,i10,x,i10,x,a3,x,i13,x,i13)" ) e , i , n , '-->' , mesh_ipNeighborhood ( 1 , n , i , e ) , mesh_ipNeighborhood ( 2 , n , i , e )
2011-02-16 21:53:08 +05:30
enddo
enddo
enddo
2010-09-30 13:01:53 +05:30
!$OMP END CRITICAL (write2out)
2011-02-16 21:53:08 +05:30
endif
deallocate ( mesh_HomogMicro )
endsubroutine
END MODULE mesh
2007-10-23 18:39:46 +05:30