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