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 createnodeneigh(nk,istartnk,ialnk,
20     &   istartnneigh,ialnneigh,ichecknodes,lakon,ipkon,kon,
21     &   nkinsetinv,neielemtot)
22!
23      implicit none
24!
25      character*8 lakon(*)
26!
27      integer nk,istartnneigh(*),ialnneigh(*),
28     &   istartnk(*),ialnk(*),ifree,index,i,j,k,nea,neb,elem,
29     &   ipkon(*),kon(*),ipos,nope,ichecknodes(*),node,
30     &   inode,nkinsetinv(*),neielemtot,nka,nkb
31!
32!     determining all the OBJECTIVE nodes (and only those;
33!     is verified by use of field nkinsetinv) of the
34!     neighboring elements of node i.
35!     They are stored in ialnneigh(istartnneigh(i))..
36!     ...up to..... ialnneigh(istartnneigh(i+1)-1)
37!
38      ifree=1
39      do i=1,nk
40!
41         istartnneigh(i)=ifree
42c         index=iponoel(i)
43c         if(index.eq.0) cycle
44         nea=istartnk(i)
45         neb=istartnk(i+1)-1
46!
47         do j=nea,neb
48!
49            elem=ialnk(j)
50            ipos=ipkon(elem)
51!
52            if(lakon(elem)(4:4).eq.'8') then
53               nope=8
54            elseif(lakon(elem)(4:5).eq.'20') then
55                nope=20
56            elseif(lakon(elem)(4:5).eq.'10') then
57               nope=10
58            elseif(lakon(elem)(4:4).eq.'4') then
59               nope=4
60            elseif(lakon(elem)(4:4).eq.'6') then
61               nope=6
62            elseif(lakon(elem)(4:5).eq.'15') then
63               nope=15
64            endif
65!
66            do k=1,nope
67               if(ichecknodes(kon(ipos+k)).eq.i) cycle
68               if(nkinsetinv(kon(ipos+k)).eq.1) then
69                  inode=kon(ipos+k)
70                  ialnneigh(ifree)=kon(ipos+k)
71                  ifree=ifree+1
72                  ichecknodes(kon(ipos+k))=i
73               endif
74            enddo
75         enddo
76      enddo
77      istartnneigh(nk+1)=ifree
78!
79!     determining an upper limit of the number of elements
80!     to which the [objective nodes belonging to the elements
81!     adjacent of node nk] belong
82!
83!     needed for allocation purposes
84!
85      neielemtot=0
86      do i=1,nk
87!
88!        loop over all neighboring objective nodes of node i
89!
90         nka=istartnneigh(i)
91         nkb=istartnneigh(i+1)-1
92         do j=nka,nkb
93            node=ialnneigh(j)
94!
95!           neighboring elements
96!
97            neielemtot=neielemtot+istartnk(node+1)-istartnk(node)
98         enddo
99      enddo
100!
101      return
102      end
103