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

Go to the source code of this file.

Functions/Subroutines

subroutine triangucont (ncont, ntie, tieset, nset, set, istartset, iendset, ialset, itietri, lakon, ipkon, kon, koncont, kind1, kind2, co, nk)
 

Function/Subroutine Documentation

◆ triangucont()

subroutine triangucont ( integer  ncont,
integer  ntie,
character*81, dimension(3,*)  tieset,
integer  nset,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer, dimension(2,ntie)  itietri,
character*8, dimension(*)  lakon,
integer, dimension(*)  ipkon,
integer, dimension(*)  kon,
integer, dimension(4,*)  koncont,
character*1  kind1,
character*1  kind2,
real*8, dimension(3,*)  co,
integer  nk 
)
22 !
23 ! generate a triangulation of the contact master surfaces
24 !
25  implicit none
26 !
27  character*1 kind1,kind2,c
28  character*3 m1,m2,m3
29  character*5 p0,p1,p2,p3,p7,p9999
30  character*8 lakon(*)
31  character*81 tieset(3,*),mastset,set(*)
32  character*88 fntria
33 !
34  integer ncont,ntie,i,j,k,l,nset,istartset(*),iendset(*),
35  & ialset(*),itrifac9(3,8),itrifac7(3,6),
36  & iright,itietri(2,ntie),nelem,jface,indexe,ipkon(*),nope,m,one,
37  & ifaceq(8,6),ifacet(6,4),ifacew1(4,5),ifacew2(8,5),node,ilen,
38  & ntrifac,itrifac3(3,1),itrifac4(3,2),itrifac6(3,4),itrifac8(3,6),
39  & itrifac(3,6),nnodelem,nface,nodef(9),kon(*),koncont(4,*),nk,
40  & ncontini
41 !
42  real*8 co(3,*)
43 !
44 ! nodes per face for hex elements
45 !
46  data ifaceq /4,3,2,1,11,10,9,12,
47  & 5,6,7,8,13,14,15,16,
48  & 1,2,6,5,9,18,13,17,
49  & 2,3,7,6,10,19,14,18,
50  & 3,4,8,7,11,20,15,19,
51  & 4,1,5,8,12,17,16,20/
52 !
53 ! nodes per face for tet elements
54 !
55  data ifacet /1,3,2,7,6,5,
56  & 1,2,4,5,9,8,
57  & 2,3,4,6,10,9,
58  & 1,4,3,8,10,7/
59 !
60 ! nodes per face for linear wedge elements
61 !
62  data ifacew1 /1,3,2,0,
63  & 4,5,6,0,
64  & 1,2,5,4,
65  & 2,3,6,5,
66  & 3,1,4,6/
67 !
68 ! nodes per face for quadratic wedge elements
69 !
70  data ifacew2 /1,3,2,9,8,7,0,0,
71  & 4,5,6,10,11,12,0,0,
72  & 1,2,5,4,7,14,10,13,
73  & 2,3,6,5,8,15,11,14,
74  & 3,1,4,6,9,13,12,15/
75 !
76 ! triangulation for three-node face
77 !
78  data itrifac3 /1,2,3/
79 !
80 ! triangulation for four-node face
81 !
82  data itrifac4 /1,2,4,2,3,4/
83 !
84 ! triangulation for six-node face
85 !
86  data itrifac6 /1,4,6,4,2,5,6,5,3,4,5,6/
87 !
88 ! triangulation for seven-node face
89 !
90  data itrifac7 /1,4,7,4,2,7,2,5,7,5,3,7,3,6,7,6,1,7/
91 !
92 ! triangulation for eight-node face
93 !
94  data itrifac8 /1,5,8,5,2,6,7,6,3,8,7,4,8,5,7,5,6,7/
95 !
96 ! triangulation for nine-node face
97 !
98  data itrifac9 /1,5,9,5,2,9,2,6,9,6,3,9,3,7,9,7,4,9,4,8,9,8,1,9/
99 !
100  ncont=0
101 !
102  do i=1,ntie
103 !
104 ! check for contact conditions
105 !
106  ncontini=ncont
107 !
108  if((tieset(1,i)(81:81).eq.kind1).or.
109  & (tieset(1,i)(81:81).eq.kind2)) then
110  mastset=tieset(3,i)
111 !
112 ! determining the master surface
113 !
114  do j=1,nset
115  if(set(j).eq.mastset) exit
116  enddo
117  if(j.gt.nset) then
118  write(*,*) '*ERROR in triangucont: master surface',
119  & mastset
120  write(*,*) ' does not exist'
121  call exit(201)
122  endif
123  iright=j
124 !
125  itietri(1,i)=ncont+1
126 !
127  do j=istartset(iright),iendset(iright)
128 !
129  nelem=int(ialset(j)/10.d0)
130  jface=ialset(j)-10*nelem
131 !
132  indexe=ipkon(nelem)
133 !
134  if(lakon(nelem)(4:5).eq.'20') then
135  nnodelem=8
136  nface=6
137  elseif(lakon(nelem)(4:4).eq.'8') then
138  nnodelem=4
139  nface=6
140  elseif(lakon(nelem)(4:5).eq.'10') then
141  nnodelem=6
142  nface=4
143  elseif(lakon(nelem)(4:4).eq.'4') then
144  nnodelem=3
145  nface=4
146  elseif(lakon(nelem)(4:5).eq.'15') then
147  if(jface.le.2) then
148  nnodelem=6
149  else
150  nnodelem=8
151  endif
152  nface=5
153  nope=15
154  elseif(lakon(nelem)(4:4).eq.'6') then
155  if(jface.le.2) then
156  nnodelem=3
157  else
158  nnodelem=4
159  endif
160  nface=5
161  nope=6
162  else
163  cycle
164  endif
165 !
166 ! determining the nodes of the face
167 !
168  if(nface.eq.4) then
169  do k=1,nnodelem
170  nodef(k)=kon(indexe+ifacet(k,jface))
171  enddo
172  elseif(nface.eq.5) then
173  if(nope.eq.6) then
174  do k=1,nnodelem
175  nodef(k)=kon(indexe+ifacew1(k,jface))
176  enddo
177  elseif(nope.eq.15) then
178  do k=1,nnodelem
179  nodef(k)=kon(indexe+ifacew2(k,jface))
180  enddo
181  endif
182  elseif(nface.eq.6) then
183  do k=1,nnodelem
184  nodef(k)=kon(indexe+ifaceq(k,jface))
185  enddo
186  endif
187 !
188 ! number of triangles
189 !
190  if(nnodelem.eq.3) then
191  ntrifac=1
192  do l=1,ntrifac
193  do k=1,3
194  itrifac(k,l)=itrifac3(k,l)
195  enddo
196  enddo
197  elseif(nnodelem.eq.4) then
198  ntrifac=2
199  do l=1,ntrifac
200  do k=1,3
201  itrifac(k,l)=itrifac4(k,l)
202  enddo
203  enddo
204  elseif(nnodelem.eq.6) then
205  ntrifac=4
206  do l=1,ntrifac
207  do k=1,3
208  itrifac(k,l)=itrifac6(k,l)
209  enddo
210  enddo
211  elseif(nnodelem.eq.7) then
212  ntrifac=6
213  do l=1,ntrifac
214  do k=1,3
215  itrifac(k,l)=itrifac7(k,l)
216  enddo
217  enddo
218  elseif(nnodelem.eq.8) then
219  ntrifac=6
220  do l=1,ntrifac
221  do k=1,3
222  itrifac(k,l)=itrifac8(k,l)
223  enddo
224  enddo
225  elseif(nnodelem.eq.9) then
226  ntrifac=8
227  do l=1,ntrifac
228  do k=1,3
229  itrifac(k,l)=itrifac9(k,l)
230  enddo
231  enddo
232  endif
233 !
234 ! storing the topology of the triangles
235 !
236  do l=1,ntrifac
237 !
238  ncont=ncont+1
239  do k=1,3
240  node=nodef(itrifac(k,l))
241  koncont(k,ncont)=node
242  enddo
243 !
244  koncont(4,ncont)=ialset(j)
245 !
246  enddo
247 !
248  enddo
249 !
250  itietri(2,i)=ncont
251 !
252  endif
253 !
254 ! storing the triangulation in .frd format
255 !
256 c ilen=index(tieset(3,i),' ')
257 c fntria(1:3)='Tri'
258 c do j=4,ilen+2
259 c fntria(j:j)=tieset(3,i)(j-3:j-3)
260 c enddo
261 c fntria(ilen+3:ilen+6)='.frd'
262 c do j=ilen+7,88
263 c fntria(j:j)=' '
264 c enddo
265 c!
266 c open(70,file=fntria,status='unknown')
267 c c='C'
268 c m1=' -1'
269 c m2=' -2'
270 c m3=' -3'
271 c p0=' 0'
272 c p1=' 1'
273 c p2=' 2'
274 c p3=' 3'
275 c p7=' 7'
276 c p9999=' 9999'
277 c one=1
278 c write(70,'(a5,a1)') p1,c
279 c write(70,'(a5,a1,67x,i1)') p2,c,one
280 c do j=1,nk
281 c write(70,'(a3,i10,1p,3e12.5)') m1,j,(co(k,j),k=1,3)
282 c enddo
283 c write(70,'(a3)') m3
284 c write(70,'(a5,a1,67x,i1)') p3,c,one
285 c do j=ncontini+1,ncont
286 c write(70,'(a3,i10,2a5)')m1,j,p7,p0
287 c write(70,'(a3,3i10)') m2,(koncont(k,j),k=1,3)
288 c enddo
289 c write(70,'(a3)') m3
290 c write(70,'(a5)') p9999
291 c close(70)
292 !
293  enddo
294 !
295  return
Hosted by OpenAircraft.com, (Michigan UAV, LLC)