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