OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
tsurftag.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!|| tsurftag ../starter/source/groups/tsurftag.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_surf ../starter/source/groups/hm_read_surf.F
27!||--- calls -----------------------------------------------------
28!|| segsurf ../starter/source/groups/tsurftag.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.f
31!||====================================================================
32 SUBROUTINE tsurftag(IXS ,IXS10 ,IGRSURF,FLAG ,NSEG ,
33 2 KNOD2ELS,NOD2ELS,N1 ,N2 ,N3 ,
34 3 NSEG0 )
35 use element_mod , only : nixs
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE groupdef_mod
40 USE message_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com04_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER IXS(NIXS,*),IXS10(6,*),
53 . KNOD2ELS(*), NOD2ELS(*)
54 INTEGER FLAG, NSEG,N1,N2,N3
55!
56 TYPE (SURF_) :: IGRSURF
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I,J,K,IE,IE10,NNS,ELEM,FACET,IORD,FC,ELEM8,
61 . MIDNOD(3,4),FACES(6,4),FACES10(3,16),FACE(3),
62 . fcmid10(3),fc10(3),iseg,nseg0
63
64 DATA midnod/1,5,4,
65 . 3,2,1,
66 . 3,6,4,
67 . 5,6,2/
68 DATA faces/2,4,6,2,4,6,
69 . 2,7,4,2,7,4,
70 . 2,7,6,2,7,6,
71 . 4,6,7,4,6,7/
72C-------------------------------------------------------------------------
73
74 iord = 0
75 elem = 0
76 elem8 = 0
77 facet = 0
78 ie10 = 0
79C-----------Search Element Tetra 10 containing the facet N1 N2 N3---------------
80
81 DO i=knod2els(n1)+1,knod2els(n1+1)
82 ie = nod2els(i)
83 IF(numels8 < ie .AND. ie <= numels8+numels10)THEN
84 DO j=1,4
85 DO k=1,3
86 IF(ixs(faces(k,j),ie)==n1.AND.ixs(faces(k+1,j),ie)==n2.AND.
87 . ixs(faces(k+2,j),ie)==n3) THEN
88 iord = 1 ! same order as defined in Faces
89 elem = ie
90 facet = j
91 ie10=ie-numels8
92 ELSEIF(ixs(faces(k,j),ie)==n1.AND.ixs(faces(k+1,j),ie)==n3.AND.
93 . ixs(faces(k+2,j),ie)==n2 ) THEN
94 iord = -1 ! opposite order than defined in Faces
95 elem = ie
96 facet = j
97 ie10=ie-numels8
98 ENDIF
99 ENDDO
100 ENDDO
101 ENDIF
102 ENDDO
103
104C----------Facet divided into 4 facets if not degenrated---------------
105c
106 IF (elem /= 0) THEN
107C still need to filter degenerated faces
108 nns=1
109 DO j=1,3
110 fcmid10(j) = ixs10(midnod(j,facet),ie10)
111 IF (fcmid10(j) /= 0) nns=nns+1
112 ENDDO
113C
114 nseg=nseg+nns
115!
116 IF (flag == 1) THEN
117 DO k=1,3
118 face(k)=ixs(faces(k,facet),elem)
119 END DO
120C
121 IF (nns==4) THEN
122c 4 triangles
123 IF (iord == 1) THEN
124 iseg = nseg-nns + 1
125 CALL segsurf(face(1),fcmid10(1),fcmid10(3),fcmid10(3),nseg0,
126 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
127 iseg = nseg-nns + 2
128 CALL segsurf(fcmid10(1),face(2),fcmid10(2),fcmid10(2),nseg0,
129 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
130 iseg = nseg-nns + 3
131 CALL segsurf(fcmid10(1),fcmid10(2),fcmid10(3),fcmid10(3),nseg0,
132 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
133 iseg = nseg-nns + 4
134 CALL segsurf(fcmid10(2),face(3),fcmid10(3),fcmid10(3),nseg0,
135 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
136 ELSE
137 iseg = nseg-nns + 1
138 CALL segsurf(face(1),fcmid10(3),fcmid10(1),fcmid10(1),nseg0,
139 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
140 iseg = nseg-nns + 2
141 CALL segsurf(fcmid10(1),fcmid10(2),face(2),face(2),nseg0,
142 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
143 iseg = nseg-nns + 3
144 CALL segsurf(fcmid10(1),fcmid10(3),fcmid10(2),fcmid10(2),nseg0,
145 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
146 iseg = nseg-nns + 4
147 CALL segsurf(fcmid10(2),fcmid10(3),face(3),face(3),nseg0,
148 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
149 ENDIF
150 ELSEIF (nns==3) THEN
151c 3 triangles
152 IF (iord == 1 ) THEN
153 IF (fcmid10(1) == 0) THEN
154 iseg = nseg-nns + 1
155 CALL segsurf(face(1),face(2),fcmid10(2),fcmid10(2),nseg0,
156 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
157 iseg = nseg-nns + 2
158 CALL segsurf(face(1),fcmid10(2),fcmid10(3),fcmid10(3),nseg0,
159 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
160 iseg = nseg-nns + 3
161 CALL segsurf(fcmid10(3),fcmid10(2),face(3),face(3),nseg0,
162 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
163 ELSEIF (fcmid10(2) == 0) THEN
164 iseg = nseg-nns + 1
165 CALL segsurf(face(1),fcmid10(1),fcmid10(3),fcmid10(3),nseg0,
166 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
167 iseg = nseg-nns + 2
168 CALL segsurf(fcmid10(1),face(2),fcmid10(3),fcmid10(3),nseg0,
169 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
170 iseg = nseg-nns + 3
171 CALL segsurf(face(2),face(3),fcmid10(3),fcmid10(3),nseg0,
172 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
173 ELSEIF (fcmid10(3) == 0) THEN
174 iseg = nseg-nns + 1
175 CALL segsurf(fcmid10(1),face(2),fcmid10(2),fcmid10(2),nseg0,
176 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
177 iseg = nseg-nns + 2
178 CALL segsurf(fcmid10(1),fcmid10(2),face(1),face(1),nseg0,
179 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
180 iseg = nseg-nns + 3
181 CALL segsurf(face(1),fcmid10(2),face(3),face(3),nseg0,
182 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
183 ENDIF
184 ELSE
185 IF (fcmid10(1) == 0) THEN
186 iseg = nseg-nns + 1
187 CALL segsurf(face(1),fcmid10(2),face(2),face(2),nseg0,
188 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
189 iseg = nseg-nns + 2
190 CALL segsurf(face(1),fcmid10(3),fcmid10(2),fcmid10(2),nseg0,
191 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
192 iseg = nseg-nns + 3
193 CALL segsurf(fcmid10(3),face(3),fcmid10(2),fcmid10(2),nseg0,
194 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
195 ELSEIF (fcmid10(2) == 0) THEN
196 iseg = nseg-nns + 1
197 CALL segsurf(face(1),fcmid10(3),fcmid10(1),fcmid10(1),nseg0,
198 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
199 iseg = nseg-nns + 2
200 CALL segsurf(fcmid10(1),fcmid10(3),face(2),face(2),nseg0,
201 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
202 iseg = nseg-nns + 3
203 CALL segsurf(face(2),fcmid10(3),face(3),face(3),nseg0,
204 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
205 ELSEIF (fcmid10(3) == 0) THEN
206 iseg = nseg-nns + 1
207 CALL segsurf(fcmid10(1),fcmid10(2),face(2),face(2),nseg0,
208 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
209 iseg = nseg-nns + 2
210 CALL segsurf(fcmid10(1),face(1),fcmid10(2),fcmid10(2),nseg0,
211 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
212 iseg = nseg-nns + 3
213 CALL segsurf(face(1),face(3),fcmid10(2),fcmid10(2),nseg0,
214 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
215 ENDIF
216 ENDIF
217 ELSEIF (nns==2) THEN
218c 2 triangles
219 IF (iord == 1 ) THEN
220 IF (fcmid10(1) /= 0) THEN
221 iseg = nseg-nns + 1
222 CALL segsurf(face(1),fcmid10(1),face(3),face(3),nseg0,
223 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
224 iseg = nseg-nns + 2
225 CALL segsurf(fcmid10(1),face(2),face(3),face(3),nseg0,
226 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
227 ELSEIF (fcmid10(2) /= 0) THEN
228 iseg = nseg-nns + 1
229 CALL segsurf(face(1),face(2),fcmid10(2),fcmid10(2),nseg0,
230 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
231 iseg = nseg-nns + 2
232 CALL segsurf(face(1),fcmid10(2),face(3),face(3),nseg0,
233 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
234 ELSEIF (fcmid10(3) /= 0) THEN
235 iseg = nseg-nns + 1
236 CALL segsurf(face(1),face(2),fcmid10(3),fcmid10(3),nseg0,
237 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
238 iseg = nseg-nns + 2
239 CALL segsurf(fcmid10(3),face(2),face(3),face(3),nseg0,
240 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
241 ENDIF
242 ELSE
243 IF (fcmid10(1) /= 0) THEN
244 iseg = nseg-nns + 1
245 CALL segsurf(face(1),face(3),fcmid10(1),fcmid10(1),nseg0,
246 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
247 iseg = nseg-nns + 2
248 CALL segsurf(fcmid10(1),face(3),face(2),face(2),nseg0,
249 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
250 ELSEIF (fcmid10(2) /= 0) THEN
251 iseg = nseg-nns + 1
252 CALL segsurf(face(1),fcmid10(2),face(2),face(2),nseg0,
253 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
254 iseg = nseg-nns + 2
255 CALL segsurf(face(1),face(3),fcmid10(2),fcmid10(2),nseg0,
256 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
257 ELSEIF (fcmid10(3) /= 0) THEN
258 iseg = nseg-nns + 1
259 CALL segsurf(face(1),fcmid10(3),face(2),face(2),nseg0,
260 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
261 iseg = nseg-nns + 2
262 CALL segsurf(fcmid10(3),face(3),face(2),face(2),nseg0,
263 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
264 ENDIF
265 ENDIF
266 ELSEIF (nns==1) THEN
267c 1 triangle
268 iseg = nseg-nns + 1
269 CALL segsurf(n1 ,n2 ,n3 ,n3,nseg0,
270 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,elem,1)
271 ENDIF
272 ENDIF
273 ELSE
274 nns = 1
275 nseg = nseg + 1
276 IF (flag==1) THEN
277 iseg = nseg
278C-------ELEM Hexa containing segment
279 CALL segsurf(n1 ,n2 ,n3 ,n3,nseg0,
280 . iseg ,igrsurf%NODES,igrsurf%ELTYP,igrsurf%ELEM,0,0)
281 ENDIF
282 ENDIF
283C
284 RETURN
285 END
286
287!||====================================================================
288!|| segsurf ../starter/source/groups/tsurftag.F
289!||--- called by ------------------------------------------------------
290!|| hm_read_surf ../starter/source/groups/hm_read_surf.F
291!|| tsurftag ../starter/source/groups/tsurftag.F
292!||====================================================================
293 SUBROUTINE segsurf(N1 ,N2 ,N3 ,N4 ,NSEG0,
294 . ISEG ,SURF_NODES,SURF_ELTYP,SURF_ELEM,ELEM,ELTY)
295C-----------------------------------------------
296C I m p l i c i t T y p e s
297C-----------------------------------------------
298#include "implicit_f.inc"
299C-----------------------------------------------
300C D u m m y A r g u m e n t s
301C-----------------------------------------------
302 INTEGER N1,N2,N3,N4,ISEG,NSEG0,ELEM,ELTY,
303 . SURF_NODES(NSEG0,4),SURF_ELTYP(NSEG0),SURF_ELEM(NSEG0)
304C-----------------------------------------------
305 surf_nodes(iseg,1) = n1
306 surf_nodes(iseg,2) = n2
307 surf_nodes(iseg,3) = n3
308 surf_nodes(iseg,4) = n4
309!
310 surf_eltyp(iseg) = elty
311 surf_elem(iseg) = elem
312!---
313 RETURN
314 END
315
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
starter
program starter
Definition starter.F:39
segsurf
subroutine segsurf(n1, n2, n3, n4, nseg0, iseg, surf_nodes, surf_eltyp, surf_elem, elem, elty)
Definition tsurftag.F:295
tsurftag
subroutine tsurftag(ixs, ixs10, igrsurf, flag, nseg, knod2els, nod2els, n1, n2, n3, nseg0)
Definition tsurftag.F:35