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 rearrangecfd(ne,ipkon,lakon,ielmat,ielorien,norien,
20     &     nef,ipkonf,lakonf,ielmatf,ielorienf,mi,nelold,nelnew,nkold,
21     &     nknew,nk,nkf,konf,nkonf,nmpc,ipompc,nodempc,coefmpc,memmpc_,
22     &     nmpcf,ipompcf,nodempcf,coefmpcf,memmpcf,nboun,nodeboun,
23     &     ndirboun,xboun,nbounf,nodebounf,ndirbounf,xbounf,nload,
24     &     nelemload,sideload,xload,nloadf,nelemloadf,sideloadf,
25     &     xloadf,ipobody,ipobodyf,kon,nkftot,co,cof,vold,voldf,
26     &     ikbounf,ilbounf,ikmpcf,ilmpcf,iambounf,iamloadf,iamboun,
27     &     iamload,xbounold,xbounoldf,xbounact,xbounactf,xloadold,
28     &     xloadoldf,xloadact,xloadactf,inotr,inotrf,nam,ntrans,
29     &     nbody)
30!
31!     renumbering nodes and elements for fluids such that no
32!     gaps result
33!
34      implicit none
35!
36      logical fluid
37!
38      character*8 lakon(*),lakonf(*)
39      character*20 sideload(*),sideloadf(*)
40!
41      integer ne,ipkon(*),mi(*),ielmat(mi(3),*),ielorien(mi(3),*),
42     &     norien,nef,ipkonf(*),ielmatf(mi(3),*),ielorienf(mi(3),*),
43     &     nelold(*),nelnew(*),nkold(*),nknew(*),nk,nkf,i,j,k,indexe,
44     &     nope,node,konf(*),nkonf,nmpc,ipompc(*),nodempc(3,*),index,
45     &     memmpc_,nmpcf,ipompcf(*),nodempcf(3,*),memmpcf,nboun,nam,
46     &     nodeboun(*),ndirboun(*),nbounf,nodebounf(*),ndirbounf(*),
47     &     nload,nelemload(2,*),nloadf,nelemloadf(2,*),ipobody(2,*),
48     &     ipobodyf(2,*),kon(*),nelem,nkftot,kflag,ikbounf(*),
49     &     ikmpcf(*),ilmpcf(*),ndir,iambounf(*),iamloadf(2,*),ntrans,
50     &     iamboun(*),iamload(2,*),inotr(2,*),inotrf(2,*),nbody,
51     &     ilbounf(*)
52!
53      real*8 coefmpc(*),coefmpcf(*),xboun(*),xbounf(*),xload(2,*),
54     &     xloadf(2,*),co(3,*),cof(3,*),vold(0:mi(2),*),
55     &     voldf(0:mi(2),*),xbounold(*),xbounoldf(*),xbounact(*),
56     &     xbounactf(*),xloadold(2,*),xloadoldf(2,*),xloadact(2,*),
57     &     xloadactf(2,*)
58!
59      kflag=2
60!
61!     rearranging the elements
62!
63      nef=0
64      do i=1,ne
65        if(ipkon(i).lt.0) cycle
66        if(lakon(i)(1:1).ne.'F') cycle
67        nef=nef+1
68        nelold(nef)=i
69        nelnew(i)=nef
70        ipkonf(nef)=ipkon(i)
71        lakonf(nef)=lakon(i)
72        do j=1,mi(3)
73          ielmatf(j,nef)=ielmat(j,i)
74        enddo
75        if(norien.gt.0) then
76          do j=1,mi(3)
77            ielorienf(j,nef)=ielorien(j,i)
78          enddo
79        endif
80      enddo
81!
82!     rearranging the nodes belonging to fluid elements
83!     setting nknew to 1 for all used fluid nodes
84!
85      do i=1,nef
86        nope=ichar(lakonf(i)(4:4))-48
87        indexe=ipkonf(i)
88        do j=1,nope
89          node=kon(indexe+j)
90          nknew(node)=1
91        enddo
92      enddo
93!
94      nkf=0
95      do i=1,nk
96        if(nknew(i).eq.1) then
97          nkf=nkf+1
98          nknew(i)=nkf
99          nkold(nkf)=i
100          do j=1,3
101            cof(j,nkf)=co(j,i)
102          enddo
103          do j=0,mi(2)
104            voldf(j,nkf)=vold(j,i)
105          enddo
106        endif
107      enddo
108      nkftot=nkf
109!
110!     setting up konf
111!
112      nkonf=0
113      do i=1,nef
114        nope=ichar(lakonf(i)(4:4))-48
115        indexe=ipkonf(i)
116        ipkonf(i)=nkonf
117        do j=1,nope
118          nkonf=nkonf+1
119          node=kon(indexe+j)
120          konf(nkonf)=nknew(node)
121        enddo
122      enddo
123!
124!     identifying the fluid MPC's
125!     adapting the node numbers
126!
127      nmpcf=0
128      memmpcf=0
129      do i=1,nmpc
130        index=ipompc(i)
131        fluid=.false.
132        do
133          if(index.eq.0) exit
134          node=nodempc(1,index)
135          if(nknew(node).gt.0) then
136            fluid=.true.
137            exit
138          endif
139          index=nodempc(3,index)
140        enddo
141!
142        if(fluid) then
143          index=ipompc(i)
144          nmpcf=nmpcf+1
145          ipompcf(nmpcf)=memmpcf+1
146          do
147            memmpcf=memmpcf+1
148            node=nodempc(1,index)
149            if(nknew(node).eq.0) then
150              nkftot=nkftot+1
151              nknew(node)=nkftot
152              nkold(nkftot)=node
153              do j=1,3
154                cof(j,nkftot)=co(j,node)
155              enddo
156              do j=0,mi(2)
157                voldf(j,nkftot)=vold(j,node)
158              enddo
159            endif
160            nodempcf(1,memmpcf)=nknew(node)
161            nodempcf(2,memmpcf)=nodempc(2,index)
162            coefmpcf(memmpcf)=coefmpc(index)
163            index=nodempc(3,index)
164            if(index.eq.0) then
165              nodempcf(3,memmpcf)=0
166              exit
167            else
168              nodempcf(3,memmpcf)=memmpcf+1
169            endif
170          enddo
171          index=ipompcf(nmpcf)
172          node=nodempcf(1,index)
173          ndir=nodempcf(2,index)
174          ikmpcf(nmpcf)=8*(node-1)+ndir
175          ilmpcf(nmpcf)=nmpcf
176        endif
177      enddo
178      call isortii(ikmpcf,ilmpcf,nmpcf,kflag)
179!
180!     identifying the fluid SPC's
181!     adapting the node numbers
182!
183      nbounf=0
184      do i=1,nboun
185        node=nodeboun(i)
186        if(nknew(node).ne.0) then
187          nbounf=nbounf+1
188          nodebounf(nbounf)=nknew(node)
189          ndirbounf(nbounf)=ndirboun(i)
190          if(nam.gt.0) iambounf(nbounf)=iamboun(i)
191          ikbounf(nbounf)=8*(nodebounf(nbounf)-1)+ndirbounf(nbounf)
192          ilbounf(nbounf)=nbounf
193          xbounf(nbounf)=xboun(i)
194          xbounoldf(nbounf)=xbounold(i)
195          xbounactf(nbounf)=xbounact(i)
196        endif
197      enddo
198      call isortii(ikbounf,ilbounf,nbounf,kflag)
199!
200!     rearranging distributed load
201!
202      nloadf=0
203      do i=1,nload
204        nelem=nelemload(1,i)
205        if(nelnew(nelem).eq.0) cycle
206        nloadf=nloadf+1
207        nelemloadf(1,nloadf)=nelnew(nelem)
208        node=nelemload(2,i)
209        if(node.gt.0) then
210          if(nknew(node).eq.0) then
211            nkftot=nkftot+1
212            nknew(node)=nkftot
213            nkold(nkftot)=node
214            do j=1,3
215              cof(j,nkftot)=co(j,node)
216            enddo
217            do j=0,mi(2)
218              voldf(j,nkftot)=vold(j,node)
219            enddo
220          endif
221          nelemloadf(2,nloadf)=nknew(node)
222        endif
223        sideloadf(nloadf)=sideload(i)
224        if(nam.gt.0) then
225          iamloadf(1,nloadf)=iamload(1,i)
226          iamloadf(2,nloadf)=iamload(2,i)
227        endif
228        xloadf(1,nloadf)=xload(1,i)
229        xloadf(2,nloadf)=xload(2,i)
230        xloadoldf(1,nloadf)=xloadold(1,i)
231        xloadoldf(2,nloadf)=xloadold(2,i)
232        xloadactf(1,nloadf)=xloadact(1,i)
233        xloadactf(2,nloadf)=xloadact(2,i)
234      enddo
235!
236!     transformations
237!
238      if(ntrans.gt.0) then
239        do i=1,nkftot
240          inotrf(1,i)=inotr(1,nkold(i))
241          if(inotrf(2,nkold(i)).eq.0) then
242            inotrf(2,i)=inotr(2,nkold(i))
243          else
244            inotrf(2,i)=nknew(inotr(2,nkold(i)))
245          endif
246        enddo
247      endif
248!
249!     rearranging body loads
250!
251      if(nbody.gt.0) then
252        do i=1,nef
253          do j=1,2
254            ipobodyf(j,i)=ipobody(j,nelold(i))
255          enddo
256        enddo
257      endif
258!
259      return
260      end
261