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