OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
solid_surface_buffer.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| solid_surface_buffer ../starter/source/model/sets/solid_surface_buffer.F
25!||--- called by ------------------------------------------------------
26!|| surface_buffer ../starter/source/model/sets/surface_buffer.F
27!||--- calls -----------------------------------------------------
28!|| surf_segment ../starter/source/model/sets/solid_surface_buffer.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE solid_surface_buffer(
32 . IXS ,IXS10 ,IXC ,IXTG ,CLAUSE ,
33 . KNOD2ELS ,NOD2ELS ,KNOD2ELC ,NOD2ELC ,KNOD2ELTG,
34 . NOD2ELTG ,NSEG ,IEXT ,BUFTMPSURF,IPARTS ,
35 . IAD_SURF ,KEYSET)
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
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46#include "com04_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER IEXT,NSEG,IAD_SURF
51 INTEGER IXS(NIXS,*),IXS10(6,*),IXC(NIXC,*),IXTG(NIXTG,*),
52 . KNOD2ELS(*),NOD2ELS(*),KNOD2ELC(*),NOD2ELC(*),
53 . KNOD2ELTG(*),NOD2ELTG(*),BUFTMPSURF(*),IPARTS(*)
54 CHARACTER(LEN=NCHARFIELD) :: KEYSET
55!
56 TYPE (SET_) :: CLAUSE
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER N,J,K,JS,KS,II,JJ,K1,K2,LL,FACE(4),FC10(3),NN,KK,I1,
61 . NI(4),NS(4),MI(4),MS(4),NMIN,MMIN,NF,MF,IPERM,N1,N2,I
62 INTEGER FACES(4,6),PWR(7),
63 . FACES10(3,6),NNS,ISHEL,ISEG,NB_SOLID,IND
64 INTEGER, DIMENSION(:), ALLOCATABLE:: SOLID_TAG,PART_TAG
65 INTEGER, DIMENSION(:), ALLOCATABLE :: NODTAG
66 INTEGER, DIMENSION(:), ALLOCATABLE :: FASTAG
67
68!
69 DATA FACES/4,3,2,1,
70 . 5,6,7,8,
71 . 1,2,6,5,
72 . 3,4,8,7,
73 . 2,3,7,6,
74 . 1,5,8,4/
75 DATA FACES10/0,0,0,
76 . 0,0,0,
77 . 3,6,4,
78 . 5,6,2,
79 . 1,2,3,
80 . 4,5,1/
81 DATA PWR/1,2,4,8,16,32,64/
82C=======================================================================
83 CALL MY_ALLOC(SOLID_TAG,NUMELS)
84 CALL MY_ALLOC(PART_TAG,NPART)
85 CALL MY_ALLOC(NODTAG,NUMNOD)
86 CALL MY_ALLOC(FASTAG,NUMELS)
87
88 SOLID_TAG(1:NUMELS)=0
89 PART_TAG(1:NPART)=0
90
91 DO I=1, CLAUSE%NB_PART
92 PART_TAG(CLAUSE%PART(I))=1
93 ENDDO
94
95 DO I=1, CLAUSE%NB_SOLID
96 SOLID_TAG(CLAUSE%SOLID(I))=1
97 ENDDO
98
99 FASTAG=0
100C
101 IF (IEXT == 1) THEN
102C
103 NB_SOLID = CLAUSE%NB_SOLID
104 DO IND=1,NB_SOLID
105 JS = CLAUSE%SOLID(IND)
106 IF (SOLID_TAG(JS)==0) CYCLE !case of tagged elems
107 DO JJ=1,6
108 DO II=1,4
109 NS(II)=IXS(FACES(II,JJ)+1,JS)
110 END DO
111C
112C keep only 1 occurrence of each node (triangles, degenerated cases...)
113C
114 DO K1=1,3
115 DO K2=K1+1,4
116 IF(NS(K2)==NS(K1))NS(K2)=0
117 END DO
118 END DO
119 NF=0
120 DO K1=1,4
121 N1=NS(K1)
122 IF(N1/=0)THEN
123 NF=NF+1
124 NS(NF)=N1
125 END IF
126 END DO
127 IF (NF < 3)CYCLE
128C
129C permute
130C
131 NMIN=NS(1)
132 DO II=2,NF
133 NMIN=MIN(NMIN,NS(II))
134 END DO
135 DO IPERM=1,NF
136.AND. IF(NMIN==NS(IPERM)
137 . NS(MOD(IPERM,NF)+1)/=NS(IPERM))THEN
138 DO II=1,NF
139 NI(II)=NS(MOD(II+IPERM-2,NF)+1)
140 END DO
141 EXIT
142 END IF
143 END DO
144C
145C looks for an elt sharing the face.
146C
147 DO K=KNOD2ELS(NI(1))+1,KNOD2ELS(NI(1)+1)
148 KS=NOD2ELS(K)
149.OR. IF (KS==JS KS > NUMELS8+NUMELS10) CYCLE
150.AND. IF (KEYSET == 'SOLID' SOLID_TAG(KS)==0) CYCLE
151.AND. IF (KEYSET == 'PART' PART_TAG(IPARTS(KS))==0) CYCLE
152!
153 DO II=1,NF
154 NODTAG(NI(II))=0
155 END DO
156 DO II=1,8
157 NODTAG(IXS(II+1,KS))=1
158 END DO
159 NN=0
160 DO II=1,NF
161 NN=NN+NODTAG(NI(II))
162 END DO
163 IF(NN==NF)THEN
164 DO KK=1,6
165 DO II=1,4
166 MS(II)=IXS(FACES(II,KK)+1,KS)
167 END DO
168C
169C keep only 1 occurrence of each node (triangles, degenerated cases...)
170C
171 DO K1=1,3
172 DO K2=K1+1,4
173 IF(MS(K2)==MS(K1))MS(K2)=0
174 END DO
175 END DO
176 MF=0
177 DO K1=1,4
178 N1=MS(K1)
179 IF(N1/=0)THEN
180 MF=MF+1
181 MS(MF)=N1
182 END IF
183 END DO
184 IF(MF /= NF)CYCLE
185C
186C permute
187C
188 MMIN=MS(1)
189 DO II=2,MF
190 MMIN=MIN(MMIN,MS(II))
191 END DO
192 DO IPERM=1,MF
193.AND. IF(MMIN==MS(IPERM)
194 . MS(MOD(IPERM,MF)+1)/=MS(IPERM))THEN
195 DO II=1,MF
196 MI(II)=MS(MOD(II+IPERM-2,MF)+1)
197 END DO
198 EXIT
199 END IF
200 END DO
201.AND. IF(MI(1)==NI(1)MI(NF)==NI(2))THEN
202C FACTAG(JS) moins face jj
203 FASTAG(JS)=FASTAG(JS)+PWR(JJ)
204 GO TO 300
205 END IF
206 END DO
207 END IF
208 END DO
209 300 CONTINUE
210 END DO
211 END DO ! DO IND=1,NB_SOLID
212 END IF ! IF(IEXT==1)THEN
213C-----------
214
215
216
217!-------
218! HEXA8
219!-------
220
221
222
223 NB_SOLID = CLAUSE%NB_SOLID
224 DO IND=1,NB_SOLID
225 JS = CLAUSE%SOLID(IND)
226 IF (SOLID_TAG(JS)==0) CYCLE
227!
228 IF (JS > NUMELS8) CYCLE ! HEXA8 ONLY
229!
230 LL=FASTAG(JS)
231 DO JJ=1,6
232 IF(MOD(LL,PWR(JJ+1))/PWR(JJ)/=0)CYCLE
233C
234C still needs to filter degenerated faces
235 DO K1=1,4
236 I1 =FACES(K1,JJ)+1
237 FACE(K1)=IXS(I1,JS)
238 END DO
239 DO K1=1,4
240 N1=FACE(K1)
241 DO K2=1,4
242 IF(K2/=K1)THEN
243 N2=FACE(K2)
244 IF(N2==N1)FACE(K2)=0
245 END IF
246 END DO
247 END DO
248 NN=0
249 DO K1=1,4
250 N1=FACE(K1)
251 IF(N1/=0)THEN
252 NN=NN+1
253 FACE(NN)=N1
254 END IF
255 END DO
256C--- find shells SURF/PART/EXT
257 IF(NN==3)THEN
258 KS = 0
259 ISHEL = 0
260 DO K=KNOD2ELTG(FACE(1))+1,KNOD2ELTG(FACE(1)+1)
261 KS=NOD2ELTG(K)
262 ISHEL = 0
263 DO I=1,3
264 DO J=1,3
265 IF(FACE(I) == IXTG(J+1,KS)) ISHEL = ISHEL + 1
266 ENDDO
267 ENDDO
268 IF (ISHEL == 3)EXIT
269 KS = 0
270 ENDDO
271 !print*,'Surf from solid ...',KS,PART_TAG(IPARTG(KS))
272.OR. IF(KS == 0 ISHEL == 3)THEN
273 NSEG = NSEG + 1
274 CALL SURF_SEGMENT(FACE(1) ,FACE(2) ,FACE(3) ,FACE(3) ,JS ,
275 . BUFTMPSURF ,IAD_SURF ,1)
276 ENDIF
277 ELSEIF(NN==4)THEN
278 KS = 0
279 ISHEL = 0
280 DO K=KNOD2ELC(FACE(1))+1,KNOD2ELC(FACE(1)+1)
281 KS=NOD2ELC(K)
282 ISHEL = 0
283 DO I=1,4
284 DO J=1,4
285 IF(FACE(I) == IXC(J+1,KS)) ISHEL = ISHEL + 1
286 ENDDO
287 ENDDO
288 IF (ISHEL == 4)EXIT
289 KS = 0
290 ENDDO
291.OR. IF(KS == 0 ISHEL == 4)THEN
292 NSEG = NSEG + 1
293 CALL SURF_SEGMENT(FACE(1) ,FACE(2) ,FACE(3) ,FACE(4) ,JS ,
294 . BUFTMPSURF ,IAD_SURF ,1)
295 ENDIF
296 END IF
297C---
298 END DO ! DO JJ=1,6
299 END DO ! DO IND=1,NB_SOLID
300
301
302
303
304!-------
305! TETRA10
306!-------
307
308
309
310 NB_SOLID = CLAUSE%NB_SOLID
311 DO IND=1,NB_SOLID
312 JS = CLAUSE%SOLID(IND)
313 IF (SOLID_TAG(JS)==0) CYCLE
314!
315 J = JS - NUMELS8 ! TETRA10 ONLY
316 IF (J <= 0) CYCLE ! TETRA10 ONLY
317!
318 LL=FASTAG(JS)
319 DO JJ=3,6
320 IF(MOD(LL,PWR(JJ+1))/PWR(JJ) /= 0)CYCLE
321C
322C still needs to filter degenerated faces
323C
324 DO K1=1,4
325 FACE(K1)=IXS(FACES(K1,JJ)+1,JS)
326 END DO
327 DO K1=1,3
328 DO K2=K1+1,4
329 IF(FACE(K2) == FACE(K1)) FACE(K2)=0
330 END DO
331 END DO
332 NN=0
333 DO K1=1,4
334 IF(FACE(K1) /= 0)THEN
335 NN=NN+1
336 FACE(NN)=FACE(K1)
337 END IF
338 END DO
339C---
340 IF(NN == 3)THEN
341 NNS=1
342 FC10(1)=IXS10(FACES10(1,JJ),J)
343 FC10(2)=IXS10(FACES10(2,JJ),J)
344 FC10(3)=IXS10(FACES10(3,JJ),J)
345 IF(FC10(1) /= 0)NNS=NNS+1
346 IF(FC10(2) /= 0)NNS=NNS+1
347 IF(FC10(3) /= 0)NNS=NNS+1
348 IF(NNS == 3)NNS=2
349 NSEG=NSEG+NNS
350 IF (NNS == 4) THEN
351c 4 triangles
352 CALL SURF_SEGMENT(FACE(1) ,FC10(1) ,FC10(3) ,FC10(3) ,JS ,
353 . BUFTMPSURF ,IAD_SURF ,1)
354 CALL SURF_SEGMENT(FACE(2) ,FC10(2) ,FC10(1) ,FC10(1) ,JS ,
355 . BUFTMPSURF ,IAD_SURF ,1)
356 CALL SURF_SEGMENT(FACE(3) ,FC10(3) ,FC10(2) ,FC10(2) ,JS ,
357 . BUFTMPSURF ,IAD_SURF ,1)
358 CALL SURF_SEGMENT(FC10(1) ,FC10(2) ,FC10(3) ,FC10(3) ,JS ,
359 . BUFTMPSURF ,IAD_SURF ,1)
360 ELSEIF (NNS == 3) THEN
361c 1 quadrangle, 1 triangle
362 IF(FC10(1) == 0)THEN
363 CALL SURF_SEGMENT(FACE(1) ,FACE(2) ,FC10(2) ,FC10(3) ,JS ,
364 . BUFTMPSURF ,IAD_SURF ,1)
365 CALL SURF_SEGMENT(FACE(3) ,FC10(3) ,FC10(2) ,FC10(2) ,JS ,
366 . BUFTMPSURF ,IAD_SURF ,1)
367 ELSEIF(FC10(2) == 0)THEN
368 CALL SURF_SEGMENT(FACE(2) ,FACE(3) ,FC10(3) ,FC10(1) ,JS ,
369 . BUFTMPSURF ,IAD_SURF ,1)
370 CALL SURF_SEGMENT(FACE(1) ,FC10(1) ,FC10(3) ,FC10(3) ,JS ,
371 . BUFTMPSURF ,IAD_SURF ,1)
372 ELSEIF(FC10(3) == 0)THEN
373 CALL SURF_SEGMENT(FACE(3) ,FACE(1) ,FC10(1) ,FC10(2) ,JS ,
374 . BUFTMPSURF ,IAD_SURF ,1)
375 CALL SURF_SEGMENT(FACE(2) ,FC10(2) ,FC10(1) ,FC10(1) ,JS ,
376 . BUFTMPSURF ,IAD_SURF ,1)
377 ENDIF
378 ELSEIF (NNS == 2) THEN
379c 2 triangles
380 IF(FC10(1) /= 0)THEN
381 CALL SURF_SEGMENT(FACE(3) ,FACE(1) ,FC10(1) ,FC10(1) ,JS ,
382 . BUFTMPSURF ,IAD_SURF ,1)
383 CALL SURF_SEGMENT(FACE(2) ,FACE(3) ,FC10(1) ,FC10(1) ,JS ,
384 . BUFTMPSURF ,IAD_SURF ,1)
385 ELSEIF(FC10(2) /= 0)THEN
386 CALL SURF_SEGMENT(FACE(1) ,FACE(2) ,FC10(2) ,FC10(2) ,JS ,
387 . BUFTMPSURF ,IAD_SURF ,1)
388 CALL SURF_SEGMENT(FACE(3) ,FACE(1) ,FC10(2) ,FC10(2) ,JS ,
389 . BUFTMPSURF ,IAD_SURF ,1)
390 ELSEIF(FC10(3) /= 0)THEN
391 CALL SURF_SEGMENT(FACE(2) ,FACE(3) ,FC10(3) ,FC10(3) ,JS ,
392 . BUFTMPSURF ,IAD_SURF ,1)
393 CALL SURF_SEGMENT(FACE(1) ,FACE(2) ,FC10(3) ,FC10(3) ,JS ,
394 . BUFTMPSURF ,IAD_SURF ,1)
395 ENDIF
396 ELSEIF (NNS == 1) THEN
397c 1 triangle
398 CALL SURF_SEGMENT(FACE(1) ,FACE(2) ,FACE(3) ,FACE(3) ,JS ,
399 . BUFTMPSURF ,IAD_SURF ,1)
400 END IF
401 END IF
402C---
403 END DO ! DO JJ=3,6
404 END DO ! DO IND=1,NB_SOLID
405C-----------
406 DEALLOCATE(NODTAG)
407 DEALLOCATE(FASTAG)
408 RETURN
409 END
410!||====================================================================
411!|| surf_segment ../starter/source/model/sets/solid_surface_buffer.F
412!||--- called by ------------------------------------------------------
413!|| quad_surface_buffer ../starter/source/model/sets/quad_surface_buffer.F
414!|| solid_surface_buffer ../starter/source/model/sets/solid_surface_buffer.F
415!||====================================================================
416 SUBROUTINE SURF_SEGMENT(N1 ,N2 ,N3 ,N4 ,ELEM,
417 . BUFTMPSURF ,IAD_SURF ,ELTYP )
418C-----------------------------------------------
419C I m p l i c i t T y p e s
420C-----------------------------------------------
421#include "implicit_f.inc"
422C-----------------------------------------------
423C D u m m y A r g u m e n t s
424C-----------------------------------------------
425 INTEGER N1,N2,N3,N4,ELEM,BUFTMPSURF(*),IAD_SURF,ELTYP
426C-----------------------------------------------
427!---
428! seg to add
429 BUFTMPSURF(IAD_SURF) = N1
430 IAD_SURF=IAD_SURF+1
431 BUFTMPSURF(IAD_SURF) = N2
432 IAD_SURF=IAD_SURF+1
433 BUFTMPSURF(IAD_SURF) = N3
434 IAD_SURF=IAD_SURF+1
435 BUFTMPSURF(IAD_SURF) = N4
436 IAD_SURF=IAD_SURF+1
437 BUFTMPSURF(IAD_SURF) = ELTYP
438 IAD_SURF=IAD_SURF+1
439 BUFTMPSURF(IAD_SURF) = ELEM ! ELEM
440 IAD_SURF=IAD_SURF+1
441!---
442 RETURN
443 END
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
setdef_mod
Definition setdef_mod.F:107
solid_surface_buffer
subroutine solid_surface_buffer(ixs, ixs10, ixc, ixtg, clause, knod2els, nod2els, knod2elc, nod2elc, knod2eltg, nod2eltg, nseg, iext, buftmpsurf, iparts, iad_surf, keyset)
Definition solid_surface_buffer.F:36