OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
monvol_triangulate_surface.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!|| monvol_triangulate_surface ../starter/source/airbag/monvol_triangulate_surface.F
25!||--- called by ------------------------------------------------------
26!|| init_monvol ../starter/source/airbag/init_monvol.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| monvol_struct_mod ../starter/share/modules1/monvol_struct_mod.F
30!||====================================================================
31 SUBROUTINE monvol_triangulate_surface(T_MONVOLN, IGRSURF, LOCAL_NODEID, LOCAL_INT_NODEID, TAGE,
32 . X, KMESH, NNS, NNI, NTG, NTGI, SIZE1, SIZE2, FVBAG_ELEMID)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE monvol_struct_mod
37 USE groupdef_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45! NSURF
46#include "com04_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 TYPE(monvol_struct_), INTENT(INOUT) :: T_MONVOLN
51 TYPE(surf_), DIMENSION(NSURF), INTENT(IN) :: IGRSURF
52 INTEGER, DIMENSION(NUMNOD), INTENT(IN) :: LOCAL_NODEID, LOCAL_INT_NODEID
53 INTEGER, DIMENSION(IGRSURF(T_MONVOLN%EXT_SURFID)%NSEG), INTENT(IN) :: TAGE
54 my_real, DIMENSION(3, NUMNOD), INTENT(IN) :: x
55 INTEGER, INTENT(IN) :: NNS, NNI, KMESH, SIZE1, SIZE2
56 INTEGER, INTENT(INOUT) :: NTG, NTGI, FVBAG_ELEMID(2 * (SIZE1 + SIZE2))
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER :: II, NODE1, NODE2, NODE3, NODE4, ITYPE, KK
61 INTEGER :: NTRI, NQUAD, NNODE, IQUAD, ITRI, INODE
62 INTEGER, DIMENSION(:), ALLOCATABLE :: QUAD, TRI, SPLITTED_QUAD
63 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: COORD
64 INTEGER, DIMENSION(:, :), ALLOCATABLE :: ELEM_TMP
65 INTEGER :: NB_FILL_TRI
66
67! ****************************************** !
68! * Counting number of triangles and quads * !
69! ****************************************** !
70 ntri = 0
71 nquad = 0
72 ntg = 0
73 ntgi = 0
74
75! External surface
76! ----------------
77 DO ii = 1, igrsurf(t_monvoln%EXT_SURFID)%NSEG
78 itype = igrsurf(t_monvoln%EXT_SURFID)%ELTYP(ii)
79 SELECT CASE (tage(ii))
80 CASE(5)
81 cycle
82 CASE(0)
83 IF (itype == 7) THEN
84 ntri = ntri + 1
85 ntg = ntg + 1
86 ELSE
87 nquad = nquad + 1
88 ntg = ntg + 2
89 ENDIF
90 CASE(1, 2, 3, 4)
91 ntri = ntri + 1
92 ntg = ntg + 1
93 END SELECT
94 ENDDO
95
96! Internal surface
97! ----------------
98 IF (t_monvoln%INT_SURFID > 0) THEN
99 DO ii = 1, igrsurf(t_monvoln%INT_SURFID)%NSEG
100 IF (igrsurf(t_monvoln%INT_SURFID)%ELTYP(ii) == 7) THEN
101 ntri = ntri + 1
102 ntgi = ntgi + 1
103 ELSE IF (igrsurf(t_monvoln%INT_SURFID)%ELTYP(ii) == 3) THEN
104 nquad = nquad + 1
105 ntgi = ntgi + 2
106 ENDIF
107 ENDDO
108 ENDIF
109
110! store triangle count into monvol struct
111! ---------------------------------------
112 t_monvoln%NTG = ntg
113 t_monvoln%NTGI = ntgi
114 nb_fill_tri = t_monvoln%NB_FILL_TRI
115
116 IF (ntg + nb_fill_tri + ntgi > 0) THEN
117 ALLOCATE(t_monvoln%ELEM(3, ntg + nb_fill_tri + ntgi))
118 ENDIF
119
120 IF (kmesh == 12 .OR. kmesh == 14) THEN
121 IF (nquad == 0) THEN
122! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* !
123! *********************************** !
124! * Surface is already triangulated * !
125! *********************************** !
126! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-* !
127 itri = 1
128 DO ii = 1, igrsurf(t_monvoln%EXT_SURFID)%NSEG
129 node1 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 1))
130 node2 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 2))
131 node3 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 3))
132 node4 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 4))
133 SELECT CASE (tage(ii))
134 CASE(5)
135 cycle
136 CASE(0)
137 t_monvoln%ELEM(1, itri) = node1
138 t_monvoln%ELEM(2, itri) = node2
139 t_monvoln%ELEM(3, itri) = node3
140 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
141 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
142 CASE(1)
143 t_monvoln%ELEM(1, itri) = node1
144 t_monvoln%ELEM(2, itri) = node2
145 t_monvoln%ELEM(3, itri) = node4
146 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
147 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
148 CASE(2)
149 t_monvoln%ELEM(1, itri) = node2
150 t_monvoln%ELEM(2, itri) = node3
151 t_monvoln%ELEM(3, itri) = node1
152 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
153 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
154 CASE(3)
155 t_monvoln%ELEM(1, itri) = node3
156 t_monvoln%ELEM(2, itri) = node4
157 t_monvoln%ELEM(3, itri) = node2
158 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
159 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
160 CASE(4)
161 t_monvoln%ELEM(1, itri) = node4
162 t_monvoln%ELEM(2, itri) = node1
163 t_monvoln%ELEM(3, itri) = node3
164 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
165 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
166 END SELECT
167 itri = itri + 1
168 ENDDO
169 IF (nb_fill_tri > 0) THEN
170 DO ii = 1, nb_fill_tri
171 node1 = t_monvoln%FILL_TRI(3 * (ii - 1) + 1)
172 node2 = t_monvoln%FILL_TRI(3 * (ii - 1) + 2)
173 node3 = t_monvoln%FILL_TRI(3 * (ii - 1) + 3)
174 t_monvoln%ELEM(1, itri) = local_nodeid(node1)
175 t_monvoln%ELEM(2, itri) = local_nodeid(node2)
176 t_monvoln%ELEM(3, itri) = local_nodeid(node3)
177 fvbag_elemid(itri) = 0
178 itri = itri + 1
179 ENDDO
180 ENDIF
181 IF (t_monvoln%INT_SURFID > 0) THEN
182 DO ii = 1, igrsurf(t_monvoln%INT_SURFID)%NSEG
183 node1 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 1))
184 node2 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 2))
185 node3 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 3))
186 t_monvoln%ELEM(1, itri) = node1
187 t_monvoln%ELEM(2, itri) = node2
188 t_monvoln%ELEM(3, itri) = node3
189 fvbag_elemid(itri) = igrsurf(t_monvoln%INT_SURFID)%ELEM(ii)
190 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
191 itri = itri + 1
192 ENDDO
193 ENDIF
194 ntg = ntg + nb_fill_tri
195 t_monvoln%NTG = t_monvoln%NTG + nb_fill_tri
196 ELSE
197! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- !
198! ********************************** !
199! * Hypermesh Smart Quad splitting * !
200! ********************************** !
201! *-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*- !
202
203! Allocate
204! --------
205 IF (ntri + nb_fill_tri > 0) ALLOCATE(tri(4 * (ntri + nb_fill_tri)))
206 IF (nquad > 0) THEN
207 ALLOCATE(quad(5 * nquad))
208 ALLOCATE(splitted_quad(6 * nquad))
209 ENDIF
210 ALLOCATE(coord(4 * (nns + nni)))
211! ***************************** !
212! * Fill in quad and tri tabs * !
213! ***************************** !
214 iquad = 0
215 itri = 0
216
217! External surface
218! ----------------
219 DO ii = 1, igrsurf(t_monvoln%EXT_SURFID)%NSEG
220 itype = igrsurf(t_monvoln%EXT_SURFID)%ELTYP(ii)
221 SELECT CASE (tage(ii))
222 CASE(5)
223 cycle
224 CASE(0)
225 IF (itype == 7) THEN
226 tri(itri + 1) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 1))
227 tri(itri + 2) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 2))
228 tri(itri + 3) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 3))
229 tri(itri + 4) = 0
230 itri = itri + 4
231 ELSE
232 quad(iquad + 1) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 1))
233 quad(iquad + 2) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 2))
234 quad(iquad + 3) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 3))
235 quad(iquad + 4) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 4))
236 quad(iquad + 5) = 0
237 iquad = iquad + 5
238 ENDIF
239 CASE(1)
240 tri(itri + 1) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 1))
241 tri(itri + 2) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 2))
242 tri(itri + 3) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 4))
243 tri(itri + 4) = 0
244 itri = itri + 4
245 CASE(2)
246 tri(itri + 1) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 2))
247 tri(itri + 2) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 3))
248 tri(itri + 3) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 1))
249 tri(itri + 4) = 0
250 itri = itri + 4
251 CASE(3)
252 tri(itri + 1) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 3))
253 tri(itri + 2) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 4))
254 tri(itri + 3) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 2))
255 tri(itri + 4) = 0
256 itri = itri + 4
257 CASE(4)
258 tri(itri + 1) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 4))
259 tri(itri + 2) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 1))
260 tri(itri + 3) = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 3))
261 tri(itri + 4) = 0
262 itri = itri + 4
263 END SELECT
264 ENDDO
265
266! Additional triangles
267! --------------------
268 IF (nb_fill_tri > 0) THEN
269 DO ii = 1, nb_fill_tri
270 node1 = t_monvoln%FILL_TRI(3 * (ii - 1) + 1)
271 node2 = t_monvoln%FILL_TRI(3 * (ii - 1) + 2)
272 node3 = t_monvoln%FILL_TRI(3 * (ii - 1) + 3)
273 tri(itri + 1) = local_nodeid(node1)
274 tri(itri + 2) = local_nodeid(node2)
275 tri(itri + 3) = local_nodeid(node3)
276 tri(itri + 4) = 0
277 itri = itri + 4
278 ENDDO
279 ENDIF
280
281! Internal surface
282! ----------------
283 IF (t_monvoln%INT_SURFID > 0) THEN
284 DO ii = 1, igrsurf(t_monvoln%INT_SURFID)%NSEG
285 IF (igrsurf(t_monvoln%INT_SURFID)%ELTYP(ii) == 7) THEN
286 tri(itri + 1) = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 1))
287 tri(itri + 2) = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 2))
288 tri(itri + 3) = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 3))
289 tri(itri + 4) = 0
290 itri = itri + 4
291 ELSE IF (igrsurf(t_monvoln%INT_SURFID)%ELTYP(ii) == 3) THEN
292 quad(iquad + 1) = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 1))
293 quad(iquad + 2) = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 2))
294 quad(iquad + 3) = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 3))
295 quad(iquad + 4) = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 4))
296 quad(iquad + 5) = 0
297 iquad = iquad + 5
298 ENDIF
299 ENDDO
300 ENDIF
301! **************************** !
302! * fill in node coordinates * !
303! **************************** !
304 inode = 0
305 nnode = nns + nni
306 DO ii = 1, nns + nni
307 coord(inode + 1) = x(1, t_monvoln%NODES(ii))
308 coord(inode + 2) = x(2, t_monvoln%NODES(ii))
309 coord(inode + 3) = x(3, t_monvoln%NODES(ii))
310 coord(inode + 4) = zero
311 inode = inode + 4
312 ENDDO
313! ********************** !
314! * Call HM quad_split * !
315! ********************** !
316#ifdef DNC
317 CALL hm_quad_split(nnode, coord(1), ntri, tri(1), nquad, quad(1), splitted_quad(1))
318#else
319 IF(nquad > 0) splitted_quad = 0
320#endif
321! **************************** !
322! * Fill in monvol structure * !
323! **************************** !
324 itri = 0
325 iquad = 0
326 DO ii = 1, igrsurf(t_monvoln%EXT_SURFID)%NSEG
327 itype = igrsurf(t_monvoln%EXT_SURFID)%ELTYP(ii)
328 node1 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 1))
329 node2 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 2))
330 node3 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 3))
331 node4 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 4))
332 SELECT CASE (tage(ii))
333 CASE(5)
334 cycle
335 CASE(0)
336 IF (itype == 3) THEN
337 iquad = iquad + 1
338 itri = itri + 1
339 t_monvoln%ELEM(1, itri) = splitted_quad(6 * (iquad - 1) + 1)
340 t_monvoln%ELEM(2, itri) = splitted_quad(6 * (iquad - 1) + 2)
341 t_monvoln%ELEM(3, itri) = splitted_quad(6 * (iquad - 1) + 3)
342 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
343 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
344 itri = itri + 1
345 t_monvoln%ELEM(1, itri) = splitted_quad(6 * (iquad - 1) + 4)
346 t_monvoln%ELEM(2, itri) = splitted_quad(6 * (iquad - 1) + 5)
347 t_monvoln%ELEM(3, itri) = splitted_quad(6 * (iquad - 1) + 6)
348 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
349 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
350 ELSE
351 itri = itri + 1
352 t_monvoln%ELEM(1, itri) = node1
353 t_monvoln%ELEM(2, itri) = node2
354 t_monvoln%ELEM(3, itri) = node3
355 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
356 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
357 ENDIF
358 CASE(1)
359 itri = itri + 1
360 t_monvoln%ELEM(1, itri) = node1
361 t_monvoln%ELEM(2, itri) = node2
362 t_monvoln%ELEM(3, itri) = node4
363 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
364 IF (itype == 7) THEN
365 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
366 ELSE
367 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
368 ENDIF
369 CASE(2)
370 itri = itri + 1
371 t_monvoln%ELEM(1, itri) = node2
372 t_monvoln%ELEM(2, itri) = node3
373 t_monvoln%ELEM(3, itri) = node1
374 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
375 IF (itype == 7) THEN
376 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
377 ELSE
378 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
379 ENDIF
380 CASE(3)
381 itri = itri + 1
382 t_monvoln%ELEM(1, itri) = node3
383 t_monvoln%ELEM(2, itri) = node4
384 t_monvoln%ELEM(3, itri) = node2
385 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
386 IF (itype == 7) THEN
387 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
388 ELSE
389 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
390 ENDIF
391 CASE(4)
392 itri = itri + 1
393 t_monvoln%ELEM(1, itri) = node4
394 t_monvoln%ELEM(2, itri) = node1
395 t_monvoln%ELEM(3, itri) = node3
396 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
397 IF (itype == 7) THEN
398 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
399 ELSE
400 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
401 ENDIF
402 END SELECT
403 ENDDO
404 IF (nb_fill_tri > 0) THEN
405 DO ii = 1, nb_fill_tri
406 node1 = t_monvoln%FILL_TRI(3 * (ii - 1) + 1)
407 node2 = t_monvoln%FILL_TRI(3 * (ii - 1) + 2)
408 node3 = t_monvoln%FILL_TRI(3 * (ii - 1) + 3)
409 itri = itri + 1
410 t_monvoln%ELEM(1, itri) = local_nodeid(node1)
411 t_monvoln%ELEM(2, itri) = local_nodeid(node2)
412 t_monvoln%ELEM(3, itri) = local_nodeid(node3)
413 fvbag_elemid(itri) = 0
414 ENDDO
415 ENDIF
416 IF (t_monvoln%INT_SURFID > 0) THEN
417 DO ii = 1, igrsurf(t_monvoln%INT_SURFID)%NSEG
418 itype = igrsurf(t_monvoln%INT_SURFID)%ELTYP(ii)
419 node1 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 1))
420 node2 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 2))
421 node3 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 3))
422 node4 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 4))
423 IF (itype == 3) THEN
424 iquad = iquad + 1
425 itri = itri + 1
426 t_monvoln%ELEM(1, itri) = splitted_quad(6 * (iquad - 1) + 1)
427 t_monvoln%ELEM(2, itri) = splitted_quad(6 * (iquad - 1) + 2)
428 t_monvoln%ELEM(3, itri) = splitted_quad(6 * (iquad - 1) + 3)
429 fvbag_elemid(itri) = igrsurf(t_monvoln%INT_SURFID)%ELEM(ii)
430 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
431 itri = itri + 1
432 t_monvoln%ELEM(1, itri) = splitted_quad(6 * (iquad - 1) + 4)
433 t_monvoln%ELEM(2, itri) = splitted_quad(6 * (iquad - 1) + 5)
434 t_monvoln%ELEM(3, itri) = splitted_quad(6 * (iquad - 1) + 6)
435 fvbag_elemid(itri) = igrsurf(t_monvoln%INT_SURFID)%ELEM(ii)
436 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
437 ELSE
438 itri = itri + 1
439 t_monvoln%ELEM(1, itri) = node1
440 t_monvoln%ELEM(2, itri) = node2
441 t_monvoln%ELEM(3, itri) = node3
442 fvbag_elemid(itri) = igrsurf(t_monvoln%INT_SURFID)%ELEM(ii)
443 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
444 ENDIF
445 ENDDO
446 ENDIF
447 ntg = ntg + nb_fill_tri
448 t_monvoln%NTG = t_monvoln%NTG + nb_fill_tri
449
450 IF (1==0) THEN
451 OPEN(unit = 210486, file = "OUTPUT_0000.rad", form ='formatted')
452 WRITE(210486, '(A)') "#RADIOSS STARTER"
453 WRITE(210486, '(A)') "/BEGIN"
454 WRITE(210486, '(A)') "ORIENTED_SURFACE "
455 WRITE(210486, '(A)') " 100 0"
456 WRITE(210486, '(A)') " g mm ms"
457 WRITE(210486, '(A)') " g mm ms"
458 WRITE(210486, "(A5)") "/NODE"
459 DO kk = 1, nnode
460 WRITE(210486, "(I10, 1PG20.13, 1PG20.13, 1PG20.13)") kk, coord(4 * (kk - 1) + 1), coord(4 * (kk - 1) + 2),
461 . coord(4 * (kk - 1) + 3)
462 ENDDO
463 WRITE(210486, "(A5)") "/SH3N"
464
465 DO kk = 1, ntg
466 WRITE(210486, '(I10,I10,I10,I10)') kk, t_monvoln%ELEM(1, kk), t_monvoln%ELEM(2, kk), t_monvoln%ELEM(3, kk)
467 ENDDO
468 CLOSE (210486)
469 ENDIF
470 IF (1==0) THEN
471 OPEN(unit = 210486, file = "OUTPUT_IN_0000.rad", form ='formatted')
472 WRITE(210486, '(A)') "#RADIOSS STARTER"
473 WRITE(210486, '(A)') "/BEGIN"
474 WRITE(210486, '(A)') "ORIENTED_SURFACE "
475 WRITE(210486, '(A)') " 100 0"
476 WRITE(210486, '(A)') " g mm ms"
477 WRITE(210486, '(A)') " g mm ms"
478 WRITE(210486, "(A5)") "/NODE"
479 DO kk = 1, nnode
480 WRITE(210486, "(I10, 1PG20.13, 1PG20.13, 1PG20.13)") kk, coord(4 * (kk - 1) + 1), coord(4 * (kk - 1) + 2),
481 . coord(4 * (kk - 1) + 3)
482 ENDDO
483 WRITE(210486, "(A5)") "/SH3N"
484
485 DO kk = ntg + 1, ntg + ntgi
486 WRITE(210486, '(I10,I10,I10,I10)') kk, t_monvoln%ELEM(1, kk), t_monvoln%ELEM(2, kk), t_monvoln%ELEM(3, kk)
487 ENDDO
488 CLOSE (210486)
489 ENDIF
490! *********************** !
491! * Memory deallocation * !
492! *********************** !
493 IF (ALLOCATED(quad)) DEALLOCATE(quad)
494 IF (ALLOCATED(tri)) DEALLOCATE(tri)
495 IF (ALLOCATED(coord)) DEALLOCATE(coord)
496 IF (ALLOCATED(splitted_quad)) DEALLOCATE(splitted_quad)
497 ENDIF
498 ELSE
499! *-*-*-*-*-*-*-*-*-*-*-*-*-*- !
500! **************************** !
501! * Radioss legacy splitting * !
502! **************************** !
503! *-*-*-*-*-*-*-*-*-*-*-*-*-*- !
504 itri = 1
505 DO ii = 1, igrsurf(t_monvoln%EXT_SURFID)%NSEG
506 itype = igrsurf(t_monvoln%EXT_SURFID)%ELTYP(ii)
507 node1 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 1))
508 node2 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 2))
509 node3 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 3))
510 node4 = local_nodeid(igrsurf(t_monvoln%EXT_SURFID)%NODES(ii, 4))
511 SELECT CASE (tage(ii))
512 CASE(5)
513 cycle
514 CASE(0)
515 IF (itype == 7) THEN
516 t_monvoln%ELEM(1, itri) = node1
517 t_monvoln%ELEM(2, itri) = node2
518 t_monvoln%ELEM(3, itri) = node3
519 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
520 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
521 ELSE
522 t_monvoln%ELEM(1, itri) = node1
523 t_monvoln%ELEM(2, itri) = node2
524 t_monvoln%ELEM(3, itri) = node4
525 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
526 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
527 itri = itri + 1
528 t_monvoln%ELEM(1, itri) = node2
529 t_monvoln%ELEM(2, itri) = node3
530 t_monvoln%ELEM(3, itri) = node4
531 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
532 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
533 ENDIF
534 CASE(1)
535 t_monvoln%ELEM(1, itri) = node1
536 t_monvoln%ELEM(2, itri) = node2
537 t_monvoln%ELEM(3, itri) = node4
538 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
539 IF (itype == 7) THEN
540 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
541 ELSE
542 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
543 ENDIF
544 CASE(2)
545 t_monvoln%ELEM(1, itri) = node2
546 t_monvoln%ELEM(2, itri) = node3
547 t_monvoln%ELEM(3, itri) = node1
548 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
549 IF (itype == 7) THEN
550 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
551 ELSE
552 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
553 ENDIF
554 CASE(3)
555 t_monvoln%ELEM(1, itri) = node3
556 t_monvoln%ELEM(2, itri) = node4
557 t_monvoln%ELEM(3, itri) = node2
558 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
559 IF (itype == 7) THEN
560 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
561 ELSE
562 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
563 ENDIF
564 CASE(4)
565 t_monvoln%ELEM(1, itri) = node4
566 t_monvoln%ELEM(2, itri) = node1
567 t_monvoln%ELEM(3, itri) = node3
568 fvbag_elemid(itri) = igrsurf(t_monvoln%EXT_SURFID)%ELEM(ii)
569 IF (itype == 7) THEN
570 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
571 ELSE
572 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
573 ENDIF
574 END SELECT
575 itri = itri + 1
576 ENDDO
577 IF (itri - 1 /= ntg) THEN
578 ntg = itri - 1
579 t_monvoln%NTG = ntg
580 ALLOCATE(elem_tmp(3, ntg))
581 DO ii = 1, ntg
582 elem_tmp(1:3, ii) = t_monvoln%ELEM(1:3, ii)
583 ENDDO
584 DEALLOCATE(t_monvoln%ELEM)
585 ALLOCATE(t_monvoln%ELEM(3, ntg + nb_fill_tri + ntgi))
586 DO ii = 1, ntg
587 t_monvoln%ELEM(1:3, ii) = elem_tmp(1:3, ii)
588 ENDDO
589 DEALLOCATE(elem_tmp)
590 ENDIF
591 IF (nb_fill_tri > 0) THEN
592 DO ii = 1, nb_fill_tri
593 node1 = t_monvoln%FILL_TRI(3 * (ii - 1) + 1)
594 node2 = t_monvoln%FILL_TRI(3 * (ii - 1) + 2)
595 node3 = t_monvoln%FILL_TRI(3 * (ii - 1) + 3)
596 t_monvoln%ELEM(1, itri) = local_nodeid(node1)
597 t_monvoln%ELEM(2, itri) = local_nodeid(node2)
598 t_monvoln%ELEM(3, itri) = local_nodeid(node3)
599 fvbag_elemid(itri) = 0
600 itri = itri + 1
601 ENDDO
602 ENDIF
603 ntg = ntg + nb_fill_tri
604 t_monvoln%NTG = t_monvoln%NTG + nb_fill_tri
605
606 IF (ntgi > 0) THEN
607 DO ii = 1, igrsurf(t_monvoln%INT_SURFID)%NSEG
608 itype = igrsurf(t_monvoln%INT_SURFID)%ELTYP(ii)
609 node1 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 1))
610 node2 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 2))
611 node3 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 3))
612 node4 = local_int_nodeid(igrsurf(t_monvoln%INT_SURFID)%NODES(ii, 4))
613 IF (itype == 7) THEN
614 t_monvoln%ELEM(1, itri) = node1
615 t_monvoln%ELEM(2, itri) = node2
616 t_monvoln%ELEM(3, itri) = node3
617 fvbag_elemid(itri) = igrsurf(t_monvoln%INT_SURFID)%ELEM(ii)
618 t_monvoln%ELTG(itri) = numelc + fvbag_elemid(itri)
619 itri = itri + 1
620 ELSE
621 t_monvoln%ELEM(1, itri) = node1
622 t_monvoln%ELEM(2, itri) = node2
623 t_monvoln%ELEM(3, itri) = node3
624 fvbag_elemid(itri) = igrsurf(t_monvoln%INT_SURFID)%ELEM(ii)
625 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
626 itri = itri + 1
627 t_monvoln%ELEM(1, itri) = node1
628 t_monvoln%ELEM(2, itri) = node3
629 t_monvoln%ELEM(3, itri) = node4
630 fvbag_elemid(itri) = igrsurf(t_monvoln%INT_SURFID)%ELEM(ii)
631 t_monvoln%ELTG(itri) = fvbag_elemid(itri)
632 itri = itri + 1
633 ENDIF
634 ENDDO
635 ENDIF
636 ENDIF
637 END SUBROUTINE monvol_triangulate_surface
my_real
#define my_real
Definition cppsort.cpp:32
monvol_triangulate_surface
subroutine monvol_triangulate_surface(t_monvoln, igrsurf, local_nodeid, local_int_nodeid, tage, x, kmesh, nns, nni, ntg, ntgi, size1, size2, fvbag_elemid)
Definition monvol_triangulate_surface.F:33
groupdef_mod
Definition groupdef_mod.F:662
monvol_struct_mod
Definition monvol_struct_mod.F:66
groupdef_mod::surf_
Definition groupdef_mod.F:745
monvol_struct_mod::monvol_struct_
Definition monvol_struct_mod.F:84