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 actideactistr(set,nset,istartset,iendset,ialset,
20     &           objectset,ipkon,iobject,ne,neinset,iponoel,inoel,
21     &           nepar,nkinsetinv,nk)
22!
23!     deactivates the elements which are not adjacent to the nodes in
24!     the STRESS objective function set
25!
26      implicit none
27!
28      character*81 objectset(5,*),set(*)
29!
30      integer i,j,k,nset,istartset(*),iendset(*),ialset(*),ipkon(*),
31     &  iobject,ne,index,nelem,iponoel(*),inoel(2,*),neinset(*),
32     &  nepar,nkinsetinv(*),nk,id
33!
34!     determining the nodes set corresponding to the STRESS
35!     objective function
36!
37c      do i=1,nset
38c         if(objectset(3,iobject).eq.set(i)) exit
39c      enddo
40      call cident81(set,objectset(3,iobject),nset,id)
41      i=nset+1
42      if(id.gt.0) then
43        if(objectset(3,iobject).eq.set(id)) then
44          i=id
45        endif
46      endif
47!
48      nepar=0
49!
50      if(i.le.nset) then
51!
52!        deactivate all elements
53!
54         do j=1,ne
55            if(ipkon(j).lt.0) cycle
56            ipkon(j)=-2-ipkon(j)
57         enddo
58!
59!        reactivate the elements adjacent to the nodes in the
60!        STRESS objective function set (the stress is extrapolated
61!        to the nodes, therefore only those elements are needed to
62!        which the nodes in the STRESS objective function belong)
63!
64         do j=istartset(i),iendset(i)
65            if(ialset(j).gt.0) then
66               index=iponoel(ialset(j))
67               nkinsetinv(ialset(j))=1
68               do
69                  if(index.eq.0) exit
70                  nelem=inoel(1,index)
71                  if(neinset(nelem).eq.0) then
72                     ipkon(nelem)=-ipkon(nelem)-2
73                     neinset(nelem)=1
74                     nepar=nepar+1
75                  endif
76                  index=inoel(2,index)
77               enddo
78            else
79               k=ialset(j-2)
80               do
81                  k=k-ialset(j)
82                  if(k.ge.ialset(j-1)) exit
83                  index=iponoel(k)
84                  nkinsetinv(k)=1
85                  do
86                     if(index.eq.0) exit
87                     nelem=inoel(1,index)
88                     if(neinset(nelem).eq.0) then
89                        ipkon(nelem)=-ipkon(nelem)-2
90                        neinset(nelem)=1
91                        nepar=nepar+1
92                     endif
93                     index=inoel(2,index)
94                  enddo
95               enddo
96            endif
97         enddo
98      else
99!
100!     all elements are taken into account
101!
102         do i=1,ne
103            if(ipkon(i).lt.0) cycle
104            neinset(i)=1
105            nepar=nepar+1
106         enddo
107         do i=1,nk
108            nkinsetinv(i)=1
109         enddo
110      endif
111!
112!     putting all active elements in ascending order in field
113!     neinset
114!
115      nepar=0
116      do i=1,ne
117         if(neinset(i).eq.1) then
118            nepar=nepar+1
119            neinset(nepar)=i
120         endif
121      enddo
122!
123      return
124      end
125