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