1!
2!     CalculiX - A 3-dimensional finite element program
3!              Copyright (C) 1998-2021 Guido Dhondt
4!
5!     This program is free software; you can redistribute it and/or
6!     modify it under the terms of the GNU General Public License as
7!     published by the Free Software Foundation(version 2);
8!
9!
10!     This program is distributed in the hope that it will be useful,
11!     but WITHOUT ANY WARRANTY; without even the implied warranty of
12!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13!     GNU General Public License for more details.
14!
15!     You should have received a copy of the GNU General Public License
16!     along with this program; if not, write to the Free Software
17!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18!
19      subroutine removesliver(netet_,kontet,iexternnode,iedtet,
20     &     iexternedg,quality,itetfa,ipofa,ipoeln,ipoeled,ipoed,
21     &     ifreetet,ifreeln,ifreele,ifreefa,ifreeed,ifatet,ifac,
22     &     iexternfa,ieln,ieled,iedg,isharp)
23!
24!     removes the slivers on the surface of a tetrahedral mesh
25!
26      implicit none
27!
28      integer i,j,m,isliver,index,icount,kontet(4,*),iexternedg(*),
29     &     iexternnode(*),nodes(4),netet_,iedtet(6,*),itetfa(2,*),
30     &     ipofa(*),ipoeln(*),ipoeled(*),ipoed(*),ifreetet,ifreeln,
31     &     ifreele,ifreefa,ifreeed,ifatet(4,*),ifac(4,*),iexternfa(*),
32     &     ieln(2,*),ieled(2,*),iedg(3,*),masted,isharp(*)
33!
34      real*8 tol,quality(*)
35!
36      isliver=0
37!
38      do m=1,2
39        loop1: do i=1,netet_
40!
41!     if a tet has exactly 5 external edges AND has a quality
42!     (aspect ratio) bigger than the desired value THEN this element
43!     is removed from the mesh
44!
45        if(kontet(1,i).eq.0) cycle
46!
47!         all nodes of the element must be external
48!
49          do j=1,4
50            nodes(j)=kontet(j,i)
51            if(iexternnode(nodes(j)).eq.0) cycle loop1
52          enddo
53!
54          tol=10.d0
55!
56!         only sufficiently bad elements are treated
57!
58          if(quality(i).gt.tol) then
59!
60!           no edges should be sharp
61!           at least 4 or 5 edges must be external
62!
63            icount=0
64            do j=1,6
65              index=iedtet(j,i)
66              if(iexternedg(index).gt.0) then
67                masted=iexternedg(index)
68                if(isharp(masted).eq.1) cycle loop1
69              endif
70              if(iexternedg(index).ne.0) icount=icount+1
71            enddo
72!
73            if(((m.eq.1).and.(icount.eq.5)).or.
74     &           ((m.eq.2).and.(icount.eq.4))) then
75              write(*,*) 'removesliver sliver element found ',i
76              isliver=isliver+1
77!
78              call removetet_sliver(kontet,ifatet,ifreetet,ifac,itetfa,
79     &             ifreefa,ipofa,i,ipoeln,ieln,ifreeln,
80     &             ipoeled,ieled,ifreele,iedtet,ipoed,iedg,
81     &             ifreeed,iexternfa,iexternedg)
82c              kontet(1,i)=0
83            endif
84!
85          endif
86!
87        enddo loop1
88      enddo
89!
90      write(*,*) 'Total number of sliver elements: ',isliver
91      write(*,*)
92!
93      return
94      end
95