OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
solid_surface_buffer.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine solid_surface_buffer (ixs, ixs10, ixc, ixtg, clause, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, nseg, iext, buftmpsurf, iparts, iad_surf, keyset)
subroutine surf_segment (n1, n2, n3, n4, elem, buftmpsurf, iad_surf, eltyp)

Function/Subroutine Documentation

◆ solid_surface_buffer()

subroutine solid_surface_buffer ( integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
integer, dimension(nixc,*) ixc,
integer, dimension(nixtg,*) ixtg,
type (set_) clause,
integer, dimension(*) knod2els,
integer, dimension(*) nod2els,
integer, dimension(*) knod2elc,
integer, dimension(*) nod2elc,
integer, dimension(*) knod2eltg,
integer, dimension(*) nod2eltg,
integer nseg,
integer iext,
integer, dimension(*) buftmpsurf,
integer, dimension(*) iparts,
integer iad_surf,
character(len=ncharfield) keyset )

Definition at line 31 of file solid_surface_buffer.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE my_alloc_mod
40 USE setdef_mod
41 USE names_and_titles_mod , ONLY : ncharfield
42 use element_mod , only : nixs,nixc,nixtg
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "com04_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IEXT,NSEG,IAD_SURF
52 INTEGER IXS(NIXS,*),IXS10(6,*),IXC(NIXC,*),IXTG(NIXTG,*),
53 . KNOD2ELS(*),NOD2ELS(*),KNOD2ELC(*),NOD2ELC(*),
54 . KNOD2ELTG(*),NOD2ELTG(*),BUFTMPSURF(*),IPARTS(*)
55 CHARACTER(LEN=NCHARFIELD) :: KEYSET
56!
57 TYPE (SET_) :: CLAUSE
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER J,K,JS,KS,II,JJ,K1,K2,LL,FACE(4),FC10(3),NN,KK,I1,
62 . NI(4),NS(4),MI(4),MS(4),NMIN,MMIN,NF,MF,IPERM,N1,N2,I
63 INTEGER FACES(4,6),PWR(7),
64 . FACES10(3,6),NNS,ISHEL,NB_SOLID,IND
65 INTEGER, DIMENSION(:), ALLOCATABLE:: SOLID_TAG,PART_TAG
66 INTEGER, DIMENSION(:), ALLOCATABLE :: NODTAG
67 INTEGER, DIMENSION(:), ALLOCATABLE :: FASTAG
68
69!
70 DATA faces/4,3,2,1,
71 . 5,6,7,8,
72 . 1,2,6,5,
73 . 3,4,8,7,
74 . 2,3,7,6,
75 . 1,5,8,4/
76 DATA faces10/0,0,0,
77 . 0,0,0,
78 . 3,6,4,
79 . 5,6,2,
80 . 1,2,3,
81 . 4,5,1/
82 DATA pwr/1,2,4,8,16,32,64/
83C=======================================================================
84 CALL my_alloc(solid_tag,numels)
85 CALL my_alloc(part_tag,npart)
86 CALL my_alloc(nodtag,numnod)
87 CALL my_alloc(fastag,numels)
88
89 solid_tag(1:numels)=0
90 part_tag(1:npart)=0
91
92 DO i=1, clause%NB_PART
93 part_tag(clause%PART(i))=1
94 ENDDO
95
96 DO i=1, clause%NB_SOLID
97 solid_tag(clause%SOLID(i))=1
98 ENDDO
99
100 fastag=0
101C
102 IF (iext == 1) THEN
103C
104 nb_solid = clause%NB_SOLID
105 DO ind=1,nb_solid
106 js = clause%SOLID(ind)
107 IF (solid_tag(js)==0) cycle !case of tagged elems
108 DO jj=1,6
109 DO ii=1,4
110 ns(ii)=ixs(faces(ii,jj)+1,js)
111 END DO
112C
113C keep only 1 occurrence of each node (triangles, degenerated cases...)
114C
115 DO k1=1,3
116 DO k2=k1+1,4
117 IF(ns(k2)==ns(k1))ns(k2)=0
118 END DO
119 END DO
120 nf=0
121 DO k1=1,4
122 n1=ns(k1)
123 IF(n1/=0)THEN
124 nf=nf+1
125 ns(nf)=n1
126 END IF
127 END DO
128 IF (nf < 3)cycle
129C
130C permute
131C
132 nmin=ns(1)
133 DO ii=2,nf
134 nmin=min(nmin,ns(ii))
135 END DO
136 DO iperm=1,nf
137 IF(nmin==ns(iperm).AND.
138 . ns(mod(iperm,nf)+1)/=ns(iperm))THEN
139 DO ii=1,nf
140 ni(ii)=ns(mod(ii+iperm-2,nf)+1)
141 END DO
142 EXIT
143 END IF
144 END DO
145C
146C looks for an elt sharing the face.
147C
148 DO k=knod2els(ni(1))+1,knod2els(ni(1)+1)
149 ks=nod2els(k)
150 IF (ks==js .OR. ks > numels8+numels10) cycle
151 IF (keyset == 'SOLID' .AND. solid_tag(ks)==0) cycle
152 IF (keyset == 'PART' .AND. part_tag(iparts(ks))==0) cycle
153!
154 DO ii=1,nf
155 nodtag(ni(ii))=0
156 END DO
157 DO ii=1,8
158 nodtag(ixs(ii+1,ks))=1
159 END DO
160 nn=0
161 DO ii=1,nf
162 nn=nn+nodtag(ni(ii))
163 END DO
164 IF(nn==nf)THEN
165 DO kk=1,6
166 DO ii=1,4
167 ms(ii)=ixs(faces(ii,kk)+1,ks)
168 END DO
169C
170C keep only 1 occurrence of each node (triangles, degenerated cases...)
171C
172 DO k1=1,3
173 DO k2=k1+1,4
174 IF(ms(k2)==ms(k1))ms(k2)=0
175 END DO
176 END DO
177 mf=0
178 DO k1=1,4
179 n1=ms(k1)
180 IF(n1/=0)THEN
181 mf=mf+1
182 ms(mf)=n1
183 END IF
184 END DO
185 IF(mf /= nf)cycle
186C
187C permute
188C
189 mmin=ms(1)
190 DO ii=2,mf
191 mmin=min(mmin,ms(ii))
192 END DO
193 DO iperm=1,mf
194 IF(mmin==ms(iperm).AND.
195 . ms(mod(iperm,mf)+1)/=ms(iperm))THEN
196 DO ii=1,mf
197 mi(ii)=ms(mod(ii+iperm-2,mf)+1)
198 END DO
199 EXIT
200 END IF
201 END DO
202 IF(mi(1)==ni(1).AND.mi(nf)==ni(2))THEN
203C Factag (JS) Less Face JJ
204 fastag(js)=fastag(js)+pwr(jj)
205 GO TO 300
206 END IF
207 END DO
208 END IF
209 END DO
210 300 CONTINUE
211 END DO
212 END DO ! DO IND=1,NB_SOLID
213 END IF ! IF(IEXT==1)THEN
214C-----------
215
216
217
218!-------
219! HEXA8
220!-------
221
222
223
224 nb_solid = clause%NB_SOLID
225 DO ind=1,nb_solid
226 js = clause%SOLID(ind)
227 IF (solid_tag(js)==0) cycle
228!
229 IF (js > numels8) cycle ! HEXA8 ONLY
230!
231 ll=fastag(js)
232 DO jj=1,6
233 IF(mod(ll,pwr(jj+1))/pwr(jj)/=0)cycle
234C
235C still needs to filter degenerated faces
236 DO k1=1,4
237 i1 =faces(k1,jj)+1
238 face(k1)=ixs(i1,js)
239 END DO
240 DO k1=1,4
241 n1=face(k1)
242 DO k2=1,4
243 IF(k2/=k1)THEN
244 n2=face(k2)
245 IF(n2==n1)face(k2)=0
246 END IF
247 END DO
248 END DO
249 nn=0
250 DO k1=1,4
251 n1=face(k1)
252 IF(n1/=0)THEN
253 nn=nn+1
254 face(nn)=n1
255 END IF
256 END DO
257C--- find shells SURF/PART/EXT
258 IF(nn==3)THEN
259 ks = 0
260 ishel = 0
261 DO k=knod2eltg(face(1))+1,knod2eltg(face(1)+1)
262 ks=nod2eltg(k)
263 ishel = 0
264 DO i=1,3
265 DO j=1,3
266 IF(face(i) == ixtg(j+1,ks)) ishel = ishel + 1
267 ENDDO
268 ENDDO
269 IF (ishel == 3)EXIT
270 ks = 0
271 ENDDO
272 !print*,'Surf from solid ...',KS,PART_TAG(IPARTG(KS))
273 IF(ks == 0 .OR. ishel == 3)THEN
274 nseg = nseg + 1
275 CALL surf_segment(face(1) ,face(2) ,face(3) ,face(3) ,js ,
276 . buftmpsurf ,iad_surf ,1)
277 ENDIF
278 ELSEIF(nn==4)THEN
279 ks = 0
280 ishel = 0
281 DO k=knod2elc(face(1))+1,knod2elc(face(1)+1)
282 ks=nod2elc(k)
283 ishel = 0
284 DO i=1,4
285 DO j=1,4
286 IF(face(i) == ixc(j+1,ks)) ishel = ishel + 1
287 ENDDO
288 ENDDO
289 IF (ishel == 4)EXIT
290 ks = 0
291 ENDDO
292 IF(ks == 0 .OR. ishel == 4)THEN
293 nseg = nseg + 1
294 CALL surf_segment(face(1) ,face(2) ,face(3) ,face(4) ,js ,
295 . buftmpsurf ,iad_surf ,1)
296 ENDIF
297 END IF
298C---
299 END DO ! DO JJ=1,6
300 END DO ! DO IND=1,NB_SOLID
301
302
303
304
305!-------
306! TETRA10
307!-------
308
309
310
311 nb_solid = clause%NB_SOLID
312 DO ind=1,nb_solid
313 js = clause%SOLID(ind)
314 IF (solid_tag(js)==0) cycle
315!
316 j = js - numels8 ! TETRA10 ONLY
317 IF (j <= 0) cycle ! TETRA10 ONLY
318!
319 ll=fastag(js)
320 DO jj=3,6
321 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
322C
323C still needs to filter degenerated faces
324C
325 DO k1=1,4
326 face(k1)=ixs(faces(k1,jj)+1,js)
327 END DO
328 DO k1=1,3
329 DO k2=k1+1,4
330 IF(face(k2) == face(k1)) face(k2)=0
331 END DO
332 END DO
333 nn=0
334 DO k1=1,4
335 IF(face(k1) /= 0)THEN
336 nn=nn+1
337 face(nn)=face(k1)
338 END IF
339 END DO
340C---
341 IF(nn == 3)THEN
342 nns=1
343 fc10(1)=ixs10(faces10(1,jj),j)
344 fc10(2)=ixs10(faces10(2,jj),j)
345 fc10(3)=ixs10(faces10(3,jj),j)
346 IF(fc10(1) /= 0)nns=nns+1
347 IF(fc10(2) /= 0)nns=nns+1
348 IF(fc10(3) /= 0)nns=nns+1
349 IF(nns == 3)nns=2
350 nseg=nseg+nns
351 IF (nns == 4) THEN
352c 4 triangles
353 CALL surf_segment(face(1) ,fc10(1) ,fc10(3) ,fc10(3) ,js ,
354 . buftmpsurf ,iad_surf ,1)
355 CALL surf_segment(face(2) ,fc10(2) ,fc10(1) ,fc10(1) ,js ,
356 . buftmpsurf ,iad_surf ,1)
357 CALL surf_segment(face(3) ,fc10(3) ,fc10(2) ,fc10(2) ,js ,
358 . buftmpsurf ,iad_surf ,1)
359 CALL surf_segment(fc10(1) ,fc10(2) ,fc10(3) ,fc10(3) ,js ,
360 . buftmpsurf ,iad_surf ,1)
361 ELSEIF (nns == 3) THEN
362c 1 quadrangle, 1 triangle
363 IF(fc10(1) == 0)THEN
364 CALL surf_segment(face(1) ,face(2) ,fc10(2) ,fc10(3) ,js ,
365 . buftmpsurf ,iad_surf ,1)
366 CALL surf_segment(face(3) ,fc10(3) ,fc10(2) ,fc10(2) ,js ,
367 . buftmpsurf ,iad_surf ,1)
368 ELSEIF(fc10(2) == 0)THEN
369 CALL surf_segment(face(2) ,face(3) ,fc10(3) ,fc10(1) ,js ,
370 . buftmpsurf ,iad_surf ,1)
371 CALL surf_segment(face(1) ,fc10(1) ,fc10(3) ,fc10(3) ,js ,
372 . buftmpsurf ,iad_surf ,1)
373 ELSEIF(fc10(3) == 0)THEN
374 CALL surf_segment(face(3) ,face(1) ,fc10(1) ,fc10(2) ,js ,
375 . buftmpsurf ,iad_surf ,1)
376 CALL surf_segment(face(2) ,fc10(2) ,fc10(1) ,fc10(1) ,js ,
377 . buftmpsurf ,iad_surf ,1)
378 ENDIF
379 ELSEIF (nns == 2) THEN
380c 2 triangles
381 IF(fc10(1) /= 0)THEN
382 CALL surf_segment(face(3) ,face(1) ,fc10(1) ,fc10(1) ,js ,
383 . buftmpsurf ,iad_surf ,1)
384 CALL surf_segment(face(2) ,face(3) ,fc10(1) ,fc10(1) ,js ,
385 . buftmpsurf ,iad_surf ,1)
386 ELSEIF(fc10(2) /= 0)THEN
387 CALL surf_segment(face(1) ,face(2) ,fc10(2) ,fc10(2) ,js ,
388 . buftmpsurf ,iad_surf ,1)
389 CALL surf_segment(face(3) ,face(1) ,fc10(2) ,fc10(2) ,js ,
390 . buftmpsurf ,iad_surf ,1)
391 ELSEIF(fc10(3) /= 0)THEN
392 CALL surf_segment(face(2) ,face(3) ,fc10(3) ,fc10(3) ,js ,
393 . buftmpsurf ,iad_surf ,1)
394 CALL surf_segment(face(1) ,face(2) ,fc10(3) ,fc10(3) ,js ,
395 . buftmpsurf ,iad_surf ,1)
396 ENDIF
397 ELSEIF (nns == 1) THEN
398c 1 triangle
399 CALL surf_segment(face(1) ,face(2) ,face(3) ,face(3) ,js ,
400 . buftmpsurf ,iad_surf ,1)
401 END IF
402 END IF
403C---
404 END DO ! DO JJ=3,6
405 END DO ! DO IND=1,NB_SOLID
406C-----------
407 DEALLOCATE(nodtag)
408 DEALLOCATE(fastag)
409 RETURN
min
#define min(a, b)
Definition macros.h:20
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1010
setdef_mod
Definition setdef_mod.F:107
surf_segment
subroutine surf_segment(n1, n2, n3, n4, elem, buftmpsurf, iad_surf, eltyp)
Definition solid_surface_buffer.F:419

◆ surf_segment()

subroutine surf_segment ( integer n1,
integer n2,
integer n3,
integer n4,
integer elem,
integer, dimension(*) buftmpsurf,
integer iad_surf,
integer eltyp )

Definition at line 417 of file solid_surface_buffer.F.

419C-----------------------------------------------
420C I m p l i c i t T y p e s
421C-----------------------------------------------
422#include "implicit_f.inc"
423C-----------------------------------------------
424C D u m m y A r g u m e n t s
425C-----------------------------------------------
426 INTEGER N1,N2,N3,N4,ELEM,BUFTMPSURF(*),IAD_SURF,ELTYP
427C-----------------------------------------------
428!---
429! seg to add
430 buftmpsurf(iad_surf) = n1
431 iad_surf=iad_surf+1
432 buftmpsurf(iad_surf) = n2
433 iad_surf=iad_surf+1
434 buftmpsurf(iad_surf) = n3
435 iad_surf=iad_surf+1
436 buftmpsurf(iad_surf) = n4
437 iad_surf=iad_surf+1
438 buftmpsurf(iad_surf) = eltyp
439 iad_surf=iad_surf+1
440 buftmpsurf(iad_surf) = elem ! ELEM
441 iad_surf=iad_surf+1
442!---
443 RETURN