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

Go to the source code of this file.

Functions/Subroutines

subroutine findsurface (ipoface, nodface, ne, ipkon, kon, lakon, ntie, tieset)
 

Function/Subroutine Documentation

◆ findsurface()

subroutine findsurface ( integer, dimension(*)  ipoface,
integer, dimension(5,*)  nodface,
integer  ne,
integer, dimension(*)  ipkon,
integer, dimension(*)  kon,
character*8, dimension(*)  lakon,
integer  ntie,
character*81, dimension(3,*)  tieset 
)
21 !
22 ! determining the external faces of the mesh and storing
23 ! them in fields ipoface and nodface
24 !
25  implicit none
26 !
27  character*8 lakon(*)
28  character*81 tieset(3,*),slavset
29 !
30  integer ipoface(*),nodface(5,*),nodes(4),
31  & ne,ipkon(*),kon(*),indexe,ifaceq(8,6),ifacet(6,4),index1,
32  & ifacew(8,5),ithree,ifour,iaux,kflag,i,j,k,m,
33  & ifree,index1old,ifreenew,ntie,ipos
34 !
35 ! nodes belonging to the element faces
36 !
37  data ifaceq /4,3,2,1,11,10,9,12,
38  & 5,6,7,8,13,14,15,16,
39  & 1,2,6,5,9,18,13,17,
40  & 2,3,7,6,10,19,14,18,
41  & 3,4,8,7,11,20,15,19,
42  & 4,1,5,8,12,17,16,20/
43  data ifacet /1,3,2,7,6,5,
44  & 1,2,4,5,9,8,
45  & 2,3,4,6,10,9,
46  & 1,4,3,8,10,7/
47  data ifacew /1,3,2,9,8,7,0,0,
48  & 4,5,6,10,11,12,0,0,
49  & 1,2,5,4,7,14,10,13,
50  & 2,3,6,5,8,15,11,14,
51  & 4,6,3,1,12,15,9,13/
52 !
53  do m=1,ntie
54 !
55 ! check for contact conditions
56 !
57  if((tieset(1,m)(81:81).eq.'C').or.
58  & (tieset(1,m)(81:81).eq.'-')) then
59  slavset=tieset(2,m)
60 !
61 ! check whether facial slave surface;
62 !
63  ipos=index(slavset,' ')-1
64  if(slavset(ipos:ipos).eq.'S') then
65  kflag=1
66  ithree=3
67  ifour=4
68 !
69 ! determining the external element faces of the solid mesh;
70 ! the faces are catalogued by the four lowest node numbers
71 ! in ascending order.
72 !
73 ! ipoface(i) points to a face for which
74 ! node i is the lowest end node and nodface(1,ipoface(i)),
75 ! nodface(2,ipoface(i)) and nodface(3,ipoface(i)) are the next
76 ! lower ones. If the face is triangular nodface(3,ipoface(i))
77 ! is zero.
78 !
79 ! nodface(4,ipoface(i)) contains the face number
80 ! (10*element number + local face number) and nodface(5,ipoface(i))
81 ! is a pointer to the next surface for which node i is the
82 ! lowest node; if there are no more such surfaces the pointer
83 ! has the value zero
84 !
85 ! An external element face is one which belongs to one element
86 ! only
87 !
88  ifree=1
89  do i=1,6*ne-1
90  nodface(5,i)=i+1
91  enddo
92  do i=1,ne
93  if(ipkon(i).lt.0) cycle
94  if(lakon(i)(1:1).ne.'C') cycle
95  indexe=ipkon(i)
96 !
97 ! hexahedral element
98 !
99  if((lakon(i)(4:4).eq.'2').or.
100  & (lakon(i)(4:4).eq.'8')) then
101  do j=1,6
102  do k=1,4
103  nodes(k)=kon(indexe+ifaceq(k,j))
104  enddo
105  call isortii(nodes,iaux,ifour,kflag)
106  index1old=0
107  index1=ipoface(nodes(1))
108  do
109 !
110 ! adding a surface which has not been
111 ! catalogued so far
112 !
113  if(index1.eq.0) then
114  ifreenew=nodface(5,ifree)
115  nodface(1,ifree)=nodes(2)
116  nodface(2,ifree)=nodes(3)
117  nodface(3,ifree)=nodes(4)
118  nodface(4,ifree)=10*i+j
119  nodface(5,ifree)=ipoface(nodes(1))
120  ipoface(nodes(1))=ifree
121  ifree=ifreenew
122  exit
123  endif
124 !
125 ! removing a surface which has already
126 ! been catalogued
127 !
128  if((nodface(1,index1).eq.nodes(2)).and.
129  & (nodface(2,index1).eq.nodes(3)).and.
130  & (nodface(3,index1).eq.nodes(4))) then
131  if(index1old.eq.0) then
132  ipoface(nodes(1))=nodface(5,index1)
133  else
134  nodface(5,index1old)=nodface(5,index1)
135  endif
136  nodface(5,index1)=ifree
137  ifree=index1
138  exit
139  endif
140  index1old=index1
141  index1=nodface(5,index1)
142  enddo
143  enddo
144 !
145 ! tetrahedral element
146 !
147  elseif((lakon(i)(4:4).eq.'4').or.
148  & (lakon(i)(4:5).eq.'10')) then
149  do j=1,4
150  do k=1,3
151  nodes(k)=kon(indexe+ifacet(k,j))
152  enddo
153  call isortii(nodes,iaux,ithree,kflag)
154  nodes(4)=0
155  index1old=0
156  index1=ipoface(nodes(1))
157  do
158 !
159 ! adding a surface which has not been
160 ! catalogues so far
161 !
162  if(index1.eq.0) then
163  ifreenew=nodface(5,ifree)
164  nodface(1,ifree)=nodes(2)
165  nodface(2,ifree)=nodes(3)
166  nodface(3,ifree)=nodes(4)
167  nodface(4,ifree)=10*i+j
168  nodface(5,ifree)=ipoface(nodes(1))
169  ipoface(nodes(1))=ifree
170  ifree=ifreenew
171  exit
172  endif
173 !
174 ! removing a surface which has already
175 ! been catalogued
176 !
177  if((nodface(1,index1).eq.nodes(2)).and.
178  & (nodface(2,index1).eq.nodes(3)).and.
179  & (nodface(3,index1).eq.nodes(4))) then
180  if(index1old.eq.0) then
181  ipoface(nodes(1))=nodface(5,index1)
182  else
183  nodface(5,index1old)=nodface(5,index1)
184  endif
185  nodface(5,index1)=ifree
186  ifree=index1
187  exit
188  endif
189  index1old=index1
190  index1=nodface(5,index1)
191  enddo
192  enddo
193  else
194 !
195 ! wedge element
196 !
197  do j=1,5
198  if(j.le.2) then
199  do k=1,3
200  nodes(k)=kon(indexe+ifacew(k,j))
201  enddo
202  call isortii(nodes,iaux,ithree,kflag)
203  nodes(4)=0
204  else
205  do k=1,4
206  nodes(k)=kon(indexe+ifacew(k,j))
207  enddo
208  call isortii(nodes,iaux,ifour,kflag)
209  endif
210  index1old=0
211  index1=ipoface(nodes(1))
212  do
213 !
214 ! adding a surface which has not been
215 ! catalogues so far
216 !
217  if(index1.eq.0) then
218  ifreenew=nodface(5,ifree)
219  nodface(1,ifree)=nodes(2)
220  nodface(2,ifree)=nodes(3)
221  nodface(3,ifree)=nodes(4)
222  nodface(4,ifree)=10*i+j
223  nodface(5,ifree)=ipoface(nodes(1))
224  ipoface(nodes(1))=ifree
225  ifree=ifreenew
226  exit
227  endif
228 !
229 ! removing a surface which has already
230 ! been catalogued
231 !
232  if((nodface(1,index1).eq.nodes(2)).and.
233  & (nodface(2,index1).eq.nodes(3)).and.
234  & (nodface(3,index1).eq.nodes(4))) then
235  if(index1old.eq.0) then
236  ipoface(nodes(1))=nodface(5,index1)
237  else
238  nodface(5,index1old)=nodface(5,index1)
239  endif
240  nodface(5,index1)=ifree
241  ifree=index1
242  exit
243  endif
244  index1old=index1
245  index1=nodface(5,index1)
246  enddo
247  enddo
248  endif
249  enddo
250  exit
251  endif
252  endif
253  enddo
254 !
255  return
isortii
subroutine isortii(ix, iy, n, kflag)
Definition: isortii.f:6
nodes
subroutine nodes(inpc, textpart, co, nk, nk_, set, istartset, iendset, ialset, nset, nset_, nalset, nalset_, istep, istat, n, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: nodes.f:22
Hosted by OpenAircraft.com, (Michigan UAV, LLC)