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 desiperelem(ndesi,istartdesi,ialdesi,ipoeldi,ieldi,
20     &      ne,istartelem,ialelem)
21!
22      implicit none
23!
24      integer ndesi,istartdesi(*),ialdesi(*),ipoeldi(*),ieldi(2,*),
25     &  ieldifree,i,j,nelem,ne,ifree,index,istartelem(*),ialelem(*)
26!
27!
28!
29!     storing the design variables per element
30!
31      ieldifree=1
32      do i=1,ndesi
33         do j=istartdesi(i),istartdesi(i+1)-1
34            nelem=ialdesi(j)
35            ieldi(1,ieldifree)=i
36            ieldi(2,ieldifree)=ipoeldi(nelem)
37            ipoeldi(nelem)=ieldifree
38            ieldifree=ieldifree+1
39         enddo
40      enddo
41!
42!     adding the zero design variable to all elements with
43!     a nonzero ipoeldi value
44!
45      do i=1,ne
46         if(ipoeldi(i).eq.0) cycle
47         ieldi(1,ieldifree)=0
48         ieldi(2,ieldifree)=ipoeldi(i)
49         ipoeldi(i)=ieldifree
50         ieldifree=ieldifree+1
51      enddo
52!
53!     determining the design variables belonging to a given
54!     element i. They are stored in ialelem(istartelem(i))..
55!     ...up to..... ialdesi(istartelem(i+1)-1)
56!
57      ifree=1
58      do i=1,ne
59         istartelem(i)=ifree
60         index=ipoeldi(i)
61         do
62            if(index.eq.0) exit
63            ialelem(ifree)=ieldi(1,index)
64c            write(*,*) 'desiperelem ',i,ialelem(ifree)
65            ifree=ifree+1
66            index=ieldi(2,index)
67         enddo
68      enddo
69      istartelem(ne+1)=ifree
70!
71      return
72      end
73