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 trianeighbor(ipe,ime,imastop,ncont,koncont, 20 & ifreeme) 21! 22! Catalogueing the neighboring triangles for a given master 23! triangle 24! 25! Authors: Li,Yang; Rakotonanahary, Samoela; 26! 27 implicit none 28! 29 integer j,k,node,ipe(*),ime(4,*),imastop(3,*),ipos,node1,node2, 30 & index1,index1old,ifreeme,ncont,koncont(4,*) 31! 32! catalogueing the edges in the triangulation 33! determining neighboring triangles 34! 35 ifreeme=0 36 do j=1,ncont 37 do k=1,3 38 node1=koncont(k,j) 39 if(k.eq.3) then 40 node2=koncont(1,j) 41 else 42 node2=koncont(k+1,j) 43 endif 44! 45 if(k.eq.1) then 46 ipos=3 47 else 48 ipos=k-1 49 endif 50! 51! making sure that node1 < node2 52! 53 if(node1.gt.node2) then 54 node=node1 55 node1=node2 56 node2=node 57 endif 58 if(ipe(node1).eq.0) then 59 ifreeme=ifreeme+1 60 ipe(node1)=ifreeme 61 ime(1,ifreeme)=node2 62 ime(2,ifreeme)=j 63 ime(3,ifreeme)=ipos 64 else 65 index1=ipe(node1) 66 if(ime(1,index1).eq.node2) then 67 imastop(ipos,j)=ime(2,index1) 68 imastop(ime(3,index1),ime(2,index1))=j 69 cycle 70 endif 71! 72 index1old=index1 73 index1=ime(4,index1) 74 do 75 if(index1.eq.0) then 76 ifreeme=ifreeme+1 77 ime(4,index1old)=ifreeme 78 ime(1,ifreeme)=node2 79 ime(2,ifreeme)=j 80 ime(3,ifreeme)=ipos 81 exit 82 endif 83 if(ime(1,index1).eq.node2) then 84 imastop(ipos,j)=ime(2,index1) 85 imastop(ime(3,index1),ime(2,index1))=j 86c ime(4,index1old)=ime(4,index1) 87 exit 88 endif 89 index1old=index1 90 index1=ime(4,index1) 91 enddo 92 endif 93 enddo 94 enddo 95! 96 return 97 end 98