CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
Functions/Subroutines
getdesiinfo.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine getdesiinfo (set, istartset, iendset, ialset, nset, mi, nactdof, ndesi, nodedesi, ntie, tieset, itmp, nmpc, nodempc, ipompc, nodedesiinv, iponoel, inoel, lakon, ipkon, kon, noregion, ipoface, nodface, nk)
 

Function/Subroutine Documentation

◆ getdesiinfo()

subroutine getdesiinfo ( character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
integer, dimension(*)  mi,
integer, dimension(0:mi(2),*)  nactdof,
integer  ndesi,
integer, dimension(*)  nodedesi,
integer  ntie,
character*81, dimension(3,*)  tieset,
integer, dimension(*)  itmp,
integer  nmpc,
integer, dimension(3,*)  nodempc,
integer, dimension(*)  ipompc,
integer, dimension(*)  nodedesiinv,
integer, dimension(*)  iponoel,
integer, dimension(2,*)  inoel,
character*8, dimension(*)  lakon,
integer, dimension(*)  ipkon,
integer, dimension(*)  kon,
integer  noregion,
integer, dimension(*)  ipoface,
integer, dimension(5,*)  nodface,
integer  nk 
)
23 !
24 ! storing the design variables in nodedesi
25 ! marking which nodes are design variables in nodedeiinv
26 !
27  implicit none
28 !
29  character*8 lakon(*)
30 !
31  character*81 setname
32  character*81 set(*)
33  character*81 tieset(3,*)
34 !
35  integer mi(*),istartset(*),iendset(*),ialset(*),ndesi,
36  & node,nodedesi(*),nset,ntie,i,j,k,l,m,nmpc,nodempc(3,*),
37  & nactdof(0:mi(2),*),itmp(*),ntmp,index,id,ipompc(*),
38  & nodedesiinv(*),iponoel(*),inoel(2,*),nelem,nope,nopedesi,
39  & ipkon(*),nnodes,kon(*),noregion,konl(26),
40  & ipoface(*),nodface(5,*),jfacem,nopesurf(9),ifaceq(8,6),
41  & ifacet(6,4),ifacew1(4,5),ifacew2(8,5),nopem,nk
42 !
43  setname(1:1)=' '
44  ndesi=0
45 !
46 ! nodes per face for hex elements
47 !
48  data ifaceq /4,3,2,1,11,10,9,12,
49  & 5,6,7,8,13,14,15,16,
50  & 1,2,6,5,9,18,13,17,
51  & 2,3,7,6,10,19,14,18,
52  & 3,4,8,7,11,20,15,19,
53  & 4,1,5,8,12,17,16,20/
54 !
55 ! nodes per face for tet elements
56 !
57  data ifacet /1,3,2,7,6,5,
58  & 1,2,4,5,9,8,
59  & 2,3,4,6,10,9,
60  & 1,4,3,8,10,7/
61 !
62 ! nodes per face for linear wedge elements
63 !
64  data ifacew1 /1,3,2,0,
65  & 4,5,6,0,
66  & 1,2,5,4,
67  & 2,3,6,5,
68  & 3,1,4,6/
69 !
70 ! nodes per face for quadratic wedge elements
71 !
72  data ifacew2 /1,3,2,9,8,7,0,0,
73  & 4,5,6,10,11,12,0,0,
74  & 1,2,5,4,7,14,10,13,
75  & 2,3,6,5,8,15,11,14,
76  & 3,1,4,6,9,13,12,15/
77 !
78 ! Search for the set name
79 !
80  do i=1,ntie
81  if(tieset(1,i)(81:81).eq.'D') then
82  setname=tieset(2,i)
83  endif
84  enddo
85 !
86 ! Check for the existence of the name
87 !
88  if(setname(1:1).eq.' ') then
89  write(*,*) '*ERROR in getdesiinfo: name of node set '
90  write(*,*) ' has not yet been defined. '
91  call exit(201)
92  endif
93 !
94 ! catalogue all nodes (dependent and independent) which
95 ! belong to MPC's
96 !
97  ntmp=0
98  do i=1,nmpc
99  index=ipompc(i)
100  do
101  if(index.eq.0) exit
102  node=nodempc(1,index)
103  call nident(itmp,node,ntmp,id)
104  if(id.gt.0) then
105  if(itmp(id).eq.node) then
106  index=nodempc(3,index)
107  cycle
108  endif
109  endif
110  ntmp=ntmp+1
111  do j=ntmp,id+2,-1
112  itmp(j)=itmp(j-1)
113  enddo
114  itmp(id+1)=node
115  index=nodempc(3,index)
116  enddo
117  enddo
118 !
119 ! opening a file to store the nodes which are rejected as
120 ! design variables
121 !
122  open(40,file='WarnNodeDesignReject.nam',status='unknown')
123  write(40,*) '*NSET,NSET=WarnNodeDesignReject'
124  write(*,*) '*INFO in getdesiinfo:'
125  write(*,*) ' rejected design nodes (if any) are stored in'
126  write(*,*) ' file WarnNodeDesignReject.nam'
127  write(*,*) ' This file can be loaded into'
128  write(*,*) ' an active cgx-session by typing'
129  write(*,*)
130  & ' read WarnNodeDesignReject.nam inp'
131  write(*,*)
132 !
133 ! Search the name of the node set in "set(i)" and
134 ! assign the nodes of the set to the appropriate variables
135 !
136  do i=1,nset
137  if(setname.eq.set(i)) then
138  loop1: do j=istartset(i),iendset(i)
139  if(ialset(j).gt.0) then
140  node=ialset(j)
141 !
142 ! check for SPC-constraints: if a node is constrained in
143 ! all dofs it is removed from the design node set
144 !
145  do l=1,3
146  if(nactdof(l,node).gt.0) exit
147  if(l.eq.3) then
148  write(*,*) '*WARNING in getdesiinfo:'
149  write(*,*) ' node ',node,' has no'
150  write(*,*) ' active dofs and'
151  write(*,*) ' is removed from the set'
152  write(*,*) ' of design variables'
153  write(40,*) node
154  cycle loop1
155  endif
156  enddo
157 !
158 ! check for MPC-constraints
159 !
160  call nident(itmp,node,ntmp,id)
161  if(id.gt.0) then
162  if(itmp(id).eq.node) then
163  write(*,*) '*WARNING in getdesiinfo:'
164  write(*,*) ' node ',node,' is subject'
165  write(*,*) ' to MPC-constraints and'
166  write(*,*) ' is removed from the set'
167  write(*,*) ' of design variables'
168  write(40,*) node
169  cycle loop1
170  endif
171  endif
172 !
173  ndesi=ndesi+1
174  nodedesi(ndesi)=node
175  else
176  k=ialset(j-2)
177  loop2: do
178  k=k-ialset(j)
179  if(k.ge.ialset(j-1)) exit
180 !
181 ! check for SPC-constraints: if a node is constrained in
182 ! all dofs it is removed from the design node set
183 !
184  do l=1,3
185  if(nactdof(l,k).gt.0) exit
186  if(l.eq.3) then
187  write(*,*) '*WARNING in getdesiinfo:'
188  write(*,*) ' node ',k,' has no'
189  write(*,*) ' active dofs and'
190  write(*,*) ' is removed from the set'
191  write(*,*) ' of design variables'
192  write(40,*) k
193  cycle loop2
194  endif
195  enddo
196 !
197 ! check for MPC-constraints
198 !
199  call nident(itmp,k,ntmp,id)
200  if(id.gt.0) then
201  if(itmp(id).eq.k) then
202  write(*,*) '*WARNING in getdesiinfo:'
203  write(*,*) ' node ',k,' is subject'
204  write(*,*) ' to MPC-constraints and'
205  write(*,*) ' is removed from the set'
206  write(*,*) ' of design variables'
207  write(40,*) k
208  cycle loop2
209  endif
210  endif
211 !
212  ndesi=ndesi+1
213  nodedesi(ndesi)=k
214  enddo loop2
215  endif
216  enddo loop1
217  endif
218  enddo
219 !
220 ! creating field nodedesiinv indicating for each node whether
221 ! it is a design variable or not
222 !
223  do i=1,ndesi
224  index=nodedesi(i)
225  nodedesiinv(index)=1
226  enddo
227 !
228  do i=1,ndesi
229  index=nodedesi(i)
230  nodedesiinv(index)=-1
231  enddo
232 !
233 ! check if sufficient nodes are defined on the surfaces of the element
234 !
235  do i=1,nk
236 ! node=nodedesi(i)
237  node=i
238  if(ipoface(node).eq.0) cycle
239  index=ipoface(node)
240  do
241  nelem=nodface(3,index)
242  jfacem=nodface(4,index)
243 !
244  if(lakon(nelem)(4:4).eq.'8') then
245  nope=8
246  nopedesi=3
247  nopem=4
248  elseif(lakon(nelem)(4:5).eq.'20') then
249  nope=20
250  nopedesi=5
251  nopem=8
252  elseif(lakon(nelem)(4:5).eq.'10') then
253  nope=10
254  nopedesi=4
255  nopem=6
256  elseif(lakon(nelem)(4:4).eq.'4') then
257  nope=4
258  nopedesi=3
259  nopem=3
260  elseif(lakon(nelem)(4:4).eq.'6') then
261  nope=6
262  if(jfacem.le.2) then
263  nopem=3
264  nopedesi=3
265  else
266  nopem=4
267  nopedesi=3
268  endif
269  elseif(lakon(nelem)(4:5).eq.'15') then
270  nope=15
271  if(jfacem.le.2) then
272  nopem=6
273  nopedesi=4
274  else
275  nopem=8
276  nopedesi=5
277  endif
278  endif
279  if(noregion.eq.1) nopedesi=0
280 !
281 ! actual position of the nodes belonging to the
282 ! master surface
283 !
284  do k=1,nope
285  konl(k)=kon(ipkon(nelem)+k)
286  enddo
287 !
288  if((nope.eq.20).or.(nope.eq.8)) then
289  do m=1,nopem
290  nopesurf(m)=konl(ifaceq(m,jfacem))
291  enddo
292  elseif((nope.eq.10).or.(nope.eq.4)) then
293  do m=1,nopem
294  nopesurf(m)=konl(ifacet(m,jfacem))
295  enddo
296  elseif(nope.eq.15) then
297  do m=1,nopem
298  nopesurf(m)=konl(ifacew2(m,jfacem))
299  enddo
300  else
301  do m=1,nopem
302  nopesurf(m)=konl(ifacew1(m,jfacem))
303  enddo
304  endif
305 !
306 ! sum up how many designvariables are on that surface
307 !
308  nnodes=0
309  do m=1,nopem
310  if(nodedesiinv(nopesurf(m)).ne.0) then
311  nnodes=nnodes+1
312  endif
313  enddo
314 !
315  if(nnodes.ge.nopedesi) then
316  do m=1,nopem
317  if(nodedesiinv(nopesurf(m)).eq.-1) then
318  nodedesiinv(nopesurf(m))=1
319  endif
320  enddo
321  endif
322  index=nodface(5,index)
323  if(index.eq.0) exit
324  enddo
325  enddo
326 !
327 ! if node i in nodedesi(i) is -1 --> delete node i from
328 ! set of designvariables
329 !
330  do i=1,nk
331  if(nodedesiinv(i).eq.-1) then
332 !
333  write(*,*) '*WARNING in getdesiinfo:'
334  write(*,*) ' node ',i,' is removed'
335  write(*,*) ' from the set of design'
336  write(*,*) ' variables as not sufficient '
337  write(*,*) ' other variables are on the '
338  write(*,*) ' surrounding element faces '
339  write(40,*) i
340 !
341  nodedesiinv(i)=0
342  call nident(nodedesi,i,ndesi,id)
343  do k=id+1,ndesi
344  nodedesi(k-1)=nodedesi(k)
345  enddo
346  ndesi=ndesi-1
347  endif
348  enddo
349 !
350  close(40)
351 !
352  return
nident
subroutine nident(x, px, n, id)
Definition: nident.f:26
Hosted by OpenAircraft.com, (Michigan UAV, LLC)