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