OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
monvol_struct_mod.F File Reference
#include "my_real.inc"
#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Data Types

type  monvol_struct_mod::monvol_metadata_
type  monvol_struct_mod::monvol_struct_

Modules

module  monvol_struct_mod

Functions/Subroutines

subroutine monvol_struct_mod::copy_to_monvol (t_monvol, licbag, icbag, smonvol, monvol)
subroutine monvol_struct_mod::copy_to_volmon (t_monvol, lrcbag, rcbag, svolmon, volmon)
subroutine monvol_struct_mod::monvol_check_surfclose (t_monvoln, itab, surf, x)
subroutine monvol_struct_mod::monvol_compute_volume (t_monvoln, title, ivolu, surf, itab, node_coord, pm, geo, ixc, ixtg, sa, rot, vol, vmin, veps, sv)
subroutine monvol_struct_mod::monvol_check_venthole_surf (ipri, t_monvoln, igrsurf, ihol, shol, x, ixc, ixtg)
subroutine monvol_struct_mod::monvol_allocate (nvolu, t_monvol, t_monvol_metadata)
subroutine monvol_struct_mod::monvol_deallocate (nvolu, t_monvol)
subroutine monvol_orient_surf (t_monvoln, title, ivolu, itab, surf, ixc, ixtg, x, itype)
subroutine monvol_reverse_normals (t_monvoln, title, ivolu, itab, surf, ixc, ixtg, vol, x, itype)
subroutine monvol_build_edges (t_monvoln, surf)

Function/Subroutine Documentation

◆ monvol_build_edges()

subroutine monvol_build_edges ( type(monvol_struct_), intent(inout) t_monvoln,
type(surf_), intent(in) surf )

Definition at line 1907 of file monvol_struct_mod.F.

1908C-----------------------------------------------
1909C D e s c r i p t i o n
1910C-----------------------------------------------
1911C Build edges connectivity of monvol external surface
1912C-----------------------------------------------
1913C M o d u l e s
1914C-----------------------------------------------
1915 USE groupdef_mod
1916 USE message_mod
1917 USE monvol_struct_mod
1918C-----------------------------------------------
1919C I m p l i c i t T y p e s
1920C-----------------------------------------------
1921#include "implicit_f.inc"
1922C-----------------------------------------------
1923C C o m m o n B l o c k s
1924C-----------------------------------------------
1925#include "param_c.inc"
1926#include "com04_c.inc"
1927C-----------------------------------------------
1928C D u m m y a r g u m e n t s
1929C-----------------------------------------------
1930 TYPE(SURF_), INTENT(IN) :: SURF
1931 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
1932C-----------------------------------------------
1933C L o c a l v a r i a b l e s
1934C-----------------------------------------------
1935 INTEGER :: NSEG, NTRI
1936 INTEGER, DIMENSION(:), ALLOCATABLE :: EDGE_ARRAY_N1, EDGE_ARRAY_N2, EDGE_ARRAY_ELEM,
1937 . NB_CONNECT
1938 INTEGER(8) :: edge_ptr
1939 INTEGER :: JJ, II(4), IDX, ELTYP, NEDG
1940C-----------------------------------------------
1941C S o u r c e L i n e s
1942C-----------------------------------------------
1943 IF (ALLOCATED(t_monvoln%EDGE_NODE1)) DEALLOCATE(t_monvoln%EDGE_NODE1)
1944 IF (ALLOCATED(t_monvoln%EDGE_NODE2)) DEALLOCATE(t_monvoln%EDGE_NODE2)
1945 IF (ALLOCATED(t_monvoln%EDGE_ELEM)) DEALLOCATE(t_monvoln%EDGE_ELEM)
1946 IF (ALLOCATED(t_monvoln%IAD_EDGE_ELEM)) DEALLOCATE(t_monvoln%IAD_EDGE_ELEM)
1947 t_monvoln%NEDGE = 0
1948
1949 nseg = surf%NSEG
1950 ntri = t_monvoln%NB_FILL_TRI
1951
1952 ALLOCATE(edge_array_n1(4 * (nseg + ntri)))
1953 ALLOCATE(edge_array_n2(4 * (nseg + ntri)))
1954 ALLOCATE(edge_array_elem(4 * (nseg + ntri)))
1955
1956! ******************************* !
1957! ** External surface elements ** !
1958! ******************************* !
1959 idx = 0
1960 DO jj = 1, nseg
1961 ii(1:4) = surf%NODES(jj, 1:4)
1962 eltyp = surf%ELTYP(jj)
1963 SELECT CASE (eltyp)
1964 CASE (3)
1965! Quads
1966 edge_array_n1(idx + 1) = min(ii(1), ii(2))
1967 edge_array_n2(idx + 1) = max(ii(1), ii(2))
1968 edge_array_n1(idx + 2) = min(ii(2), ii(3))
1969 edge_array_n2(idx + 2) = max(ii(2), ii(3))
1970 edge_array_n1(idx + 3) = min(ii(3), ii(4))
1971 edge_array_n2(idx + 3) = max(ii(3), ii(4))
1972 edge_array_n1(idx + 4) = min(ii(4), ii(1))
1973 edge_array_n2(idx + 4) = max(ii(4), ii(1))
1974 edge_array_elem(idx + 1:idx + 4) = jj
1975 idx = idx + 4
1976 CASE (7)
1977! Tri
1978 edge_array_n1(idx + 1) = min(ii(1), ii(2))
1979 edge_array_n2(idx + 1) = max(ii(1), ii(2))
1980 edge_array_n1(idx + 2) = min(ii(2), ii(3))
1981 edge_array_n2(idx + 2) = max(ii(2), ii(3))
1982 edge_array_n1(idx + 3) = min(ii(3), ii(1))
1983 edge_array_n2(idx + 3) = max(ii(3), ii(1))
1984 edge_array_elem(idx + 1:idx + 3) = jj
1985 idx = idx + 3
1986 CASE DEFAULT
1987
1988 END SELECT
1989 ENDDO
1990
1991! **************************** !
1992! ** Filling hole triangles ** !
1993! **************************** !
1994 DO jj = 1, ntri
1995 ii(1:3) = t_monvoln%FILL_TRI(3 * (jj - 1) + 1 : 3 * (jj - 1) + 3)
1996 edge_array_n1(idx + 1) = min(ii(1), ii(2))
1997 edge_array_n2(idx + 1) = max(ii(1), ii(2))
1998 edge_array_n1(idx + 2) = min(ii(2), ii(3))
1999 edge_array_n2(idx + 2) = max(ii(2), ii(3))
2000 edge_array_n1(idx + 3) = min(ii(3), ii(1))
2001 edge_array_n2(idx + 3) = max(ii(3), ii(1))
2002 edge_array_elem(idx + 1:idx + 3) = jj + nseg
2003 idx = idx + 3
2004 ENDDO
2005 nedg = idx
2006
2007! ********************************* !
2008! ** Edge sorting and compaction ** !
2009! ********************************* !
2010
2011 edge_ptr = 0
2012 CALL edge_sort(edge_ptr, edge_array_n1, edge_array_n2, edge_array_elem, nedg)
2013 ALLOCATE(nb_connect(nedg))
2014 CALL edge_get_nb_connect(edge_ptr, nb_connect)
2015
2016 ALLOCATE(t_monvoln%EDGE_NODE1(nedg))
2017 ALLOCATE(t_monvoln%EDGE_NODE2(nedg))
2018 ALLOCATE(t_monvoln%EDGE_ELEM(sum(nb_connect)))
2019 ALLOCATE(t_monvoln%IAD_EDGE_ELEM(nedg + 1))
2020
2021 CALL edge_get_connect(edge_ptr, t_monvoln%EDGE_ELEM)
2022
2023 t_monvoln%IAD_EDGE_ELEM(1) = 1
2024 DO jj = 2, nedg + 1
2025 t_monvoln%IAD_EDGE_ELEM(jj) = t_monvoln%IAD_EDGE_ELEM(jj - 1) + nb_connect(jj - 1)
2026 ENDDO
2027 DO jj = 1, nedg
2028 t_monvoln%EDGE_NODE1(jj) = edge_array_n1(jj)
2029 t_monvoln%EDGE_NODE2(jj) = edge_array_n2(jj)
2030 ENDDO
2031
2032 CALL edge_free_memory(edge_ptr)
2033 t_monvoln%NEDGE = nedg
2034 t_monvoln%EDGES_BUILT = .true.
2035
2036! ************************* !
2037! ** Memory deallocation ** !
2038! ************************* !
2039 DEALLOCATE(edge_array_n1)
2040 DEALLOCATE(edge_array_n2)
2041 DEALLOCATE(edge_array_elem)
2042 DEALLOCATE(nb_connect)
2043C-----------------------------------------------
2044C E n d O f S u b r o u t i n e
2045C-----------------------------------------------
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
monvol_struct_mod
Definition monvol_struct_mod.F:66

◆ monvol_orient_surf()

subroutine monvol_orient_surf ( type(monvol_struct_), intent(inout) t_monvoln,
character(len = nchartitle), intent(in) title,
integer, dimension(nimv), intent(in) ivolu,
integer, dimension(*), intent(in) itab,
type(surf_), intent(inout) surf,
integer, dimension(nixc, numelc), intent(in) ixc,
integer, dimension(nixtg, numeltg), intent(in) ixtg,
x,
integer, intent(in) itype )

Definition at line 1109 of file monvol_struct_mod.F.

1110C-----------------------------------------------
1111C D e s c r i p t i o n
1112C-----------------------------------------------
1113C This subroutines ensures that all normal from monvol surface are
1114C oriented on same side.
1115C volume sign of resulting oriented surface is not ensured
1116C
1117C FIND ADJACENT ELEMS (by pair)
1118C -----------------------------
1119C
1120C 10 9 8 RUN THGROUGH ELEM SORTING 1st COLUMN SORTING 2nd COLUMN FOR EACH BLOCK (siz > 2)
1121C +----+----+ node1 node2 elem_id node1 node2 elem_id
1122C | | | 1 2 17 1 10 17 } BLOCK
1123C | 17 | 11 | 2 9 17 1 2 17 }
1124C | | | 9 10 17 SORT.1 ---------------- ----------------
1125C +----+----+ 1 10 17 -----> 2 9 17 } SORT.2 2 3 11 }
1126C 1 2 3 2 3 11 2 3 11 BLOCK -----> 2 9 17 ONE COMMON EDGE IN BLOCK : 2,3
1127C 3 8 11 2 9 11 } 2 9 11 } => elem 17 & 11 are adjacent
1128C 8 9 11 ---------------- ----------------
1129C 9 10 11 3 8 11
1130C ^ ^ ^ ----------------
1131C EDGE_ARRAY_N1 ^ ^ 8 9 11
1132C EDGE_ARRAY_N2 ^ ----------------
1133C EDGE_ARRAY_ELEM 9 10 17
1134C
1135C
1136C CHECK CONNECTIVITY
1137C -----------------
1138C
1139C 10 9 8
1140C +-----+----+ EXAMPLE :
1141C | | | reference elem : {09,10,01,02} U {09}
1142C | REF | 11 | elem to treat : {08,03,02,09} U {08}
1143C | | |
1144C +-----+----+ 1. check pattern [09,10] in elem to treat : not found
1145C 1 2 3 2. check pattern [10,01] in elem to treat : not found
1146C 3. check pattern [01,02] in elem to treat : not found
1147C 4. check pattern [02,09] in elem to treat : found => reverse connectivity
1148C
1149C REVERSE CONNECTIVITY
1150C --------------------
1151C
1152C 1 2 1 2
1153C +-------+ +---------+
1154C | | \ SH3N /
1155C | SHELL | \ / SHELL : switch 2<->4
1156C | | \ / SH3N : switch 1<->2
1157C +-------+ \ /
1158C 4 3 +3
1159C
1160C
1161C-----------------------------------------------
1162C M o d u l e s
1163C-----------------------------------------------
1164 USE groupdef_mod
1165 USE message_mod
1166 USE monvol_struct_mod
1167C-----------------------------------------------
1168C I m p l i c i t T y p e s
1169C-----------------------------------------------
1170#include "implicit_f.inc"
1171C-----------------------------------------------
1172C C o m m o n B l o c k s
1173C-----------------------------------------------
1174#include "param_c.inc"
1175#include "com04_c.inc"
1176C-----------------------------------------------
1177C D u m m y A r g u m e n t s
1178C-----------------------------------------------
1179 CHARACTER(LEN = nchartitle), INTENT(IN) :: TITLE
1180 INTEGER, INTENT(IN) :: IVOLU(NIMV), ITAB(*),ITYPE, IXC(NIXC, NUMELC), IXTG(NIXTG, NUMELTG)
1181 my_real :: x(3,numnod)
1182 TYPE(SURF_), INTENT(INOUT) :: SURF
1183 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
1184C-----------------------------------------------
1185C L o c a l v a r i a b l e s
1186C-----------------------------------------------
1187 INTEGER NSEG,ISH34,JJ,II(4),KK, IELEM_ADJ,IDX,IDX_A,IDX_B,IPAIR,NPAIR,LL
1188 INTEGER IDX1,IDX2
1189 INTEGER NEDG, SUM_ADJ
1190 !temporary memory
1191 INTEGER, ALLOCATABLE,DIMENSION(:) :: PATHS, SIZES, CHECK_FLAG_ELEM, NB_ADJ,IAD_ADJ, LIST_ADJ_TAB
1192 INTEGER,ALLOCATABLE,DIMENSION(:) :: db_reversed, db_path
1193 INTEGER, DIMENSION(:), ALLOCATABLE :: PAIR_LIST, NB_PAIR_BY_EDGE
1194 INTEGER :: NB_NOEUD, NB_ARC, NB_COMP_CONNEXE, SUM_SIZES
1195 INTEGER(8) :: graph_ptr
1196 INTEGER :: IELEM,ICOMP, EDGES_A(5),EDGES_B(5), NB_REVERSED
1197 INTEGER :: NPT_A, NPT_B, IELEM1, IELEM2, ELTYP1, ELTYP2, NB_COMMON_NODE,
1198 . NODELIST1(4), NODELIST2(4), ELEM1ID, ELEM2ID, ELEMTG, ELEMC, IELEMTG, IELEMC
1199 LOGICAL :: lFOUND, lFOUND_ADJ
1200 INTEGER :: NB_DUPLICATED_ELTS
1201 INTEGER, DIMENSION(:), ALLOCATABLE :: DUPLICATED_ELTS
1202 CHARACTER(LEN=1024) :: FILENAME
1203 INTEGER(8) :: duplicate_ptr
1204 LOGICAL debug_output
1205 INTEGER :: NTRI, NB_CON
1206 INTEGER, DIMENSION(:), ALLOCATABLE :: IAD_COMP_CONNEX
1207C-----------------------------------------------
1208C P r e C o n d i t i o n
1209C-----------------------------------------------
1210C! only type 'PRES' (2) and type 'AIRBAG1' (7) FVMBAG1 (8)
1211C! otherwise : unplug
1212C IF(ITYPE /= 2 .AND.
1213C . ITYPE /= 7 .AND.
1214C . ITYPE /= 8 )RETURN
1215C-----------------------------------------------
1216C S o u r c e L i n e s
1217C-----------------------------------------------
1218
1219 graph_ptr = 0
1220 nseg = surf%NSEG
1221 ntri = t_monvoln%NB_FILL_TRI
1222 t_monvoln%OK_REORIENT = .true.
1223
1224! ********************************* !
1225! ** Edge connectivity if needed ** !
1226! ********************************* !
1227
1228 IF (.NOT. t_monvoln%EDGES_BUILT) THEN
1229 CALL monvol_build_edges(t_monvoln, surf)
1230 ENDIF
1231 nedg = t_monvoln%NEDGE
1232
1233! ********************************* !
1234! ** Find any duplicated element ** !
1235! ********************************* !
1236! REMOVE ONE OF EACH THEM FROM THE EDGE CONNECTIVITY
1237 nb_duplicated_elts = 0
1238 duplicate_ptr = 0
1239 CALL tab1_init(duplicate_ptr)
1240 DO jj = 1, nedg
1241 nb_con = t_monvoln%IAD_EDGE_ELEM(jj + 1) - t_monvoln%IAD_EDGE_ELEM(jj)
1242 IF (nb_con > 2) THEN
1243! T connection or worse
1244 DO ielem1 = t_monvoln%IAD_EDGE_ELEM(jj), t_monvoln%IAD_EDGE_ELEM(jj + 1) - 1
1245 IF (t_monvoln%EDGE_ELEM(ielem1) /= 0) THEN
1246 DO ielem2 = t_monvoln%IAD_EDGE_ELEM(jj), t_monvoln%IAD_EDGE_ELEM(jj + 1) -1
1247 IF (ielem1 /= ielem2) THEN
1248 elem1id = t_monvoln%EDGE_ELEM(ielem1)
1249 elem2id = t_monvoln%EDGE_ELEM(ielem2)
1250 IF (elem1id * elem2id == 0) THEN
1251! One of the element have already been suppressed as duplicated from another element
1252! connected to the same edge
1253 cycle
1254 ENDIF
1255 eltyp1 = surf%ELTYP(elem1id)
1256 eltyp2 = surf%ELTYP(elem2id)
1257 IF (eltyp1 == eltyp2) THEN
1258 IF (eltyp1 == 7) THEN
1259! Two triangles
1260 nb_common_node = 0
1261 nodelist1(1:4) = (/0, ixtg(2:4,surf%ELEM(elem1id))/)
1262 nodelist2(1:4) = (/0, ixtg(2:4,surf%ELEM(elem2id))/)
1263 DO kk = 2, 4
1264 DO ll = 2, 4
1265 IF (nodelist1(kk) == nodelist2(ll)) THEN
1266 nb_common_node = nb_common_node + 1
1267 EXIT
1268 ENDIF
1269 ENDDO
1270 ENDDO
1271 IF (nb_common_node == 3) THEN
1272! Get rid of ELEM2
1273 t_monvoln%EDGE_ELEM(ielem2) = 0
1274 nb_duplicated_elts = nb_duplicated_elts + 1
1275 CALL tab1_append(duplicate_ptr, elem1id)
1276 CALL tab1_append(duplicate_ptr, elem2id)
1277 ENDIF
1278 ENDIF
1279 ELSEIF (eltyp1 == 3) THEN
1280! Two QUADS
1281 nb_common_node = 0
1282 nodelist1(1:4) = (/ixc(2:5,surf%ELEM(elem1id))/)
1283 nodelist2(1:4) = (/ixc(2:5,surf%ELEM(elem2id))/)
1284 DO kk = 1, 4
1285 DO ll = 1, 4
1286 IF (nodelist1(kk) == nodelist2(ll)) THEN
1287 nb_common_node = nb_common_node + 1
1288 EXIT
1289 ENDIF
1290 ENDDO
1291 ENDDO
1292 IF (nb_common_node == 4) THEN
1293! Get rid of ELEM2
1294 t_monvoln%EDGE_ELEM(ielem2) = 0
1295 nb_duplicated_elts = nb_duplicated_elts + 1
1296 CALL tab1_append(duplicate_ptr, elem1id)
1297 CALL tab1_append(duplicate_ptr, elem2id)
1298 ENDIF
1299 ELSE
1300! One triangle, one quad
1301 ielemtg = ielem2
1302 elemtg = elem2id
1303 ielemc = ielem1
1304 elemc = elem1id
1305 IF (eltyp1 == 7) THEN
1306 ielemtg = ielem1
1307 elemtg = elem1id
1308 ielemc = ielem2
1309 elemc = elem2id
1310 ENDIF
1311 nb_common_node = 0
1312 nodelist1(1:4) = (/0, ixtg(2:4,surf%ELEM(elemtg))/)
1313 nodelist2(1:4) = (/ixc(2:5,surf%ELEM(elemc))/)
1314 DO kk = 2, 4
1315 DO ll = 1, 4
1316 IF (nodelist1(kk) == nodelist2(ll)) THEN
1317 nb_common_node = nb_common_node + 1
1318 EXIT
1319 ENDIF
1320 ENDDO
1321 ENDDO
1322 IF (nb_common_node == 3) THEN
1323! Get rid of the triangle
1324 t_monvoln%EDGE_ELEM(ielemtg) = 0
1325 nb_duplicated_elts = nb_duplicated_elts + 1
1326 CALL tab1_append(duplicate_ptr, elemc)
1327 CALL tab1_append(duplicate_ptr, ielemtg)
1328 ENDIF
1329 ENDIF
1330 ENDIF
1331 ENDDO
1332 ENDIF
1333 ENDDO
1334 ENDIF
1335 ENDDO
1336
1337 !--------------------------------------------!
1338 ! 4. BUILD PAIRS FOR GRAPH PATH CONSTRUCTION !
1339 !--------------------------------------------!
1340! Number of pairs by edge
1341 ALLOCATE(nb_pair_by_edge(nedg))
1342 DO jj = 1, nedg
1343 nb_pair_by_edge(jj) = 0
1344 DO kk = t_monvoln%IAD_EDGE_ELEM(jj), t_monvoln%IAD_EDGE_ELEM(jj + 1) - 1
1345 IF (t_monvoln%EDGE_ELEM(kk) /= 0) THEN
1346 nb_pair_by_edge(jj) = nb_pair_by_edge(jj) + 1
1347 ENDIF
1348 ENDDO
1349 nb_pair_by_edge(jj) = (nb_pair_by_edge(jj) - 1) * nb_pair_by_edge(jj) / 2
1350 IF (nb_pair_by_edge(jj) > 1) THEN
1351 t_monvoln%OK_REORIENT = .false.
1352 ENDIF
1353 ENDDO
1354 npair = sum(nb_pair_by_edge)
1355 ALLOCATE(pair_list(2 * npair))
1356 ipair = 0
1357 DO jj = 1, nedg
1358 nb_con = t_monvoln%IAD_EDGE_ELEM(jj + 1) - t_monvoln%IAD_EDGE_ELEM(jj)
1359 DO kk = 1, nb_con
1360 DO ll = kk + 1, nb_con
1361 elem1id = t_monvoln%EDGE_ELEM(t_monvoln%IAD_EDGE_ELEM(jj) + kk - 1)
1362 elem2id = t_monvoln%EDGE_ELEM(t_monvoln%IAD_EDGE_ELEM(jj) + ll - 1)
1363 IF (elem1id .NE.0 .AND. elem2id .NE. 0) THEN
1364 pair_list(ipair + 1) = elem1id - 1
1365 pair_list(ipair + 2) = elem2id - 1
1366 ipair = ipair + 2
1367 ENDIF
1368 ENDDO
1369 ENDDO
1370 ENDDO
1371
1372 !------------------------------------!
1373 ! 5. BUILD GRAPH !
1374 !------------------------------------!
1375 ! result : graph_ptr
1376 !------------------------------------!
1377 nb_noeud=nseg+ntri
1378 nb_arc=npair
1379 nb_comp_connexe = 0
1380 CALL graph_build_path(nb_noeud, nb_arc, pair_list, nb_comp_connexe, graph_ptr)
1381
1382 !------------------------------------!
1383 ! 6. GET PATH !
1384 !------------------------------------!
1385 ! result : PATHS(1:SIZE(1),SIZE(1)+1..SIZE(2),...)
1386 !------------------------------------!
1387 IF(.NOT.ALLOCATED(sizes))ALLOCATE(sizes(0:nb_comp_connexe))
1388 ALLOCATE(iad_comp_connex(nb_comp_connexe+1))
1389 CALL graph_get_sizes(graph_ptr, sizes(1))
1390 sum_sizes=sum(sizes(1:nb_comp_connexe),1)
1391 sizes(0)=0
1392 iad_comp_connex(1) = 1
1393 DO jj = 2, nb_comp_connexe + 1
1394 iad_comp_connex(jj) = iad_comp_connex(jj - 1) + sizes(jj - 1)
1395 ENDDO
1396 IF(.NOT.ALLOCATED(paths))ALLOCATE(paths(sum_sizes))
1397 CALL graph_get_path(graph_ptr, paths)
1398
1399 !----------------------------------------!
1400 ! 7. DEBUG : HM TCL SCRIPT TO CHECK PATH !
1401 !----------------------------------------!
1402 debug_output=.false.
1403C if(debug_output)then
1404C WRITE(FILENAME1, "(A,I0,A)") "surfmesh_",T_MONVOLN%ID,"_list_ids.tcl"
1405C OPEN(UNIT = 220582, FILE = FILENAME1, FORM ='formatted')
1406C write (220582,FMT='(A)')"set ids { \"
1407C kk=0
1408C do while (kk < sizes(1))
1409C if(kk+1<sizes(1))then
1410C ISH34 = SURF%ELTYP(1+PATHS(kk+1))
1411C IF(ISH34==3)THEN
1412C write (220582,FMT='(I10,A,I10,A)')IXC(7,SURF%ELEM(1+PATHS(kk+1)) ) ," ",10000000+IXC(7,SURF%ELEM(1+PATHS(kk+1)) ),' \'
1413C ELSE
1414C write (220582,FMT='(I10,A,I10,A)')IXTG(6,SURF%ELEM(1+PATHS(kk+1)) )," ",10000000+IXTG(6,SURF%ELEM(1+PATHS(kk+1)) ),' \'
1415C ENDIF
1416C endif
1417C kk=kk+1
1418C enddo
1419C write (220582,FMT='(A)') " } ; "
1420C CLOSE(220582)
1421C
1422C WRITE(FILENAME2, "(A,I0,A)") "surfmesh_",T_MONVOLN%ID,"_list_types.tcl"
1423C OPEN(UNIT = 220582, FILE = FILENAME2, FORM ='formatted')
1424C write (220582,FMT='(A)')"set types { \"
1425C kk=0
1426C do while (kk < sizes(1))
1427C if(kk+1<sizes(1))then
1428C ISH34 = SURF%ELTYP(1+PATHS(kk+1))
1429C IF(ISH34==3)THEN
1430C write (*,FMT='(I10,A,I10,A)')3 ," ",3,' \'
1431C ELSE
1432C write (*,FMT='(I10,A,I10,A)')7," ",7,' \'
1433C ENDIF
1434C endif
1435C kk=kk+1
1436C enddo
1437C CLOSE(220582)
1438C
1439C WRITE(FILENAME, "(A,I0,A)") "surfmesh_",T_MONVOLN%ID,"_HM_TCL_MACTO.tcl"
1440C OPEN(UNIT = 220582, FILE = FILENAME, FORM ='formatted')
1441C write (220582,FMT='(A)') '#--$ids '
1442C write (220582,FMT='(A)') '::hwt::Source "'//FILENAME1//'";'
1443C write (220582,FMT='(A)') '#--$types '
1444C write (220582,FMT='(A)') '::hwt::Source "'//FILENAME2//'";'
1445C write (220582,FMT='(A)') ' '
1446C write (220582,FMT='(A)') 'for {set i 0} {$i < [llength $ids]} {incr i 2} { '
1447C write (220582,FMT='(A)') ' set ityp [lindex $types $i] '
1448C write (220582,FMT='(A)') ' set id [lindex $ids $i] '
1449C write (220582,FMT='(A)') ' '
1450C write (220582,FMT='(A)') ' if {$ityp == 3} { '
1451C write (220582,FMT='(A)') ' *createmark elements 1 [hm_getinternalid shell_idpool $id -bypoolname] ;'
1452C write (220582,FMT='(A)') ' } elseif {$ityp == 7} { '
1453C write (220582,FMT='(A)') ' *createmark elements 1 [hm_getinternalid sh3n_idpool $id -bypoolname] ; '
1454C write (220582,FMT='(A)') ' } '
1455C write (220582,FMT='(A)') ' hm_redraw; '
1456C write (220582,FMT='(A)') ' *movemark elements 1 \"COLOR\"; '
1457C write (220582,FMT='(A)') '} '
1458C CLOSE(220582)
1459C endif !(debug_output)
1460
1461 !------------------------------------!
1462 ! 8. GET PATH !
1463 !------------------------------------!
1464 IF(.NOT.ALLOCATED(nb_adj))ALLOCATE(nb_adj(nseg+ntri))
1465 IF(.NOT.ALLOCATED(iad_adj))ALLOCATE(iad_adj(nseg+ntri+1))
1466 CALL graph_get_nb_adj(graph_ptr, nb_adj)
1467 sum_adj=sum(nb_adj)
1468 iad_adj(1)=1
1469 DO kk=2,nseg+ntri+1
1470 iad_adj(kk)=iad_adj(kk-1)+nb_adj(kk-1)
1471 ENDDO
1472 IF(.NOT.ALLOCATED(list_adj_tab))ALLOCATE(list_adj_tab(sum_adj))
1473 CALL graph_get_adj(graph_ptr, list_adj_tab)
1474 DO kk=1,sum_adj
1475 list_adj_tab(kk)=list_adj_tab(kk)+1
1476 ENDDO
1477 !------------------------------------!
1478 ! 7. DEBUG OUTPUT : SURF IN FILE !
1479 !------------------------------------!
1480 !--write a Radioss input file to check final surface
1481 debug_output=.false.
1482 if(debug_output)then
1483 nseg=surf%NSEG
1484 WRITE(filename, "(A,I0,A)") "surfmesh_before_",t_monvoln%ID,"_0000.rad"
1485 OPEN(unit = 210486, file = trim(filename), form ='formatted')
1486 WRITE(210486, '(A)') "#RADIOSS STARTER"
1487 WRITE(210486, '(A)') "/BEGIN"
1488 WRITE(210486, '(A)') "ORIENTED_SURFACE "
1489 WRITE(210486, '(A)') " 100 0"
1490 WRITE(210486, '(A)') " g mm ms"
1491 WRITE(210486, '(A)') " g mm ms"
1492 WRITE(210486, "(A5)") "/NODE"
1493 DO kk = 1, numnod
1494 WRITE(210486, "(I10, 1PG20.13, 1PG20.13, 1PG20.13)") itab(kk),x(1, kk), x(2, kk), x(3, kk)
1495 ENDDO
1496 DO kk = 1, nseg
1497 ii(1:4) = surf%NODES(kk,1:4)
1498 ish34 = surf%ELTYP(kk)
1499 IF (ish34 == 3) THEN
1500 WRITE(210486, "(A6)") "/SHELL"
1501 WRITE(210486, '(I10,I10,I10,I10,I10)') ixc(7,surf%ELEM(kk)), itab(ii(1)), itab(ii(2)),itab(ii(3)), itab(ii(4))
1502 ENDIF
1503 ENDDO
1504 DO kk = 1, nseg
1505 ii(1:4) = surf%NODES(kk,1:4)
1506 ish34 = surf%ELTYP(kk)
1507 IF (ish34 == 7) THEN
1508 WRITE(210486, "(A5)") "/SH3N"
1509 WRITE(210486, '(I10,I10,I10,I10)') ixtg(6,surf%ELEM(kk)), itab(ii(1)), itab(ii(2)),itab(ii(3))
1510 ENDIF
1511 ENDDO
1512 IF (t_monvoln%NB_FILL_TRI > 0) THEN
1513 WRITE(210486, "(A5)") "/SH3N"
1514 ENDIF
1515 DO kk = 1, t_monvoln%NB_FILL_TRI
1516 WRITE(210486, '(I10,I10,I10,I10)') kk + nseg, itab(t_monvoln%FILL_TRI(3 * (kk - 1) + 1)),
1517 . itab(t_monvoln%FILL_TRI(3 * (kk - 1) + 2)), itab(t_monvoln%FILL_TRI(3 * (kk - 1) + 3))
1518 ENDDO
1519 CLOSE (210486)
1520 endif !debug_output
1521 !------------------------------------!
1522 ! 9. SPREAD NORMAL !
1523 !------------------------------------!
1524 ! result : SIZES(1:NB_COMP_CONNEXE)
1525 !------------------------------------!
1526 IF(.NOT.ALLOCATED(check_flag_elem))ALLOCATE(check_flag_elem(nseg+ntri))
1527 check_flag_elem(:)=0
1528
1529 IF (t_monvoln%OK_REORIENT) THEN
1530 DO icomp=1,nb_comp_connexe
1531
1532!--REFERENCE ELEM (FIRST ONE)
1533 jj = 1 + paths(iad_comp_connex(icomp))
1534
1535 check_flag_elem(jj)=1 !already traveled
1536 nb_reversed = 0
1537
1538 DO ielem=iad_comp_connex(icomp) + 1, iad_comp_connex(icomp + 1) - 1
1539
1540!--CURRENT ELEM
1541 jj=1+paths(ielem)
1542
1543 IF (jj <= nseg) THEN
1544 ii(1:4) = surf%NODES(jj,1:4)
1545 ish34 = surf%ELTYP(jj)
1546 IF(ish34==3.AND.ii(3)/=ii(4))THEN
1547 edges_a(1:5)=(/ ii(1:4), ii(1) /)
1548 npt_a=4
1549 ELSE
1550 edges_a(1:5)=(/ ii(1:3), ii(1), 0 /)
1551 npt_a=3
1552 ENDIF
1553 ELSE
1554 ii(1:3) = t_monvoln%FILL_TRI(3 * (jj - nseg - 1) + 1 : 3 * (jj - nseg - 1) + 3)
1555 ii(4) = ii(3)
1556 edges_a(1:5) = (/ ii(1:3), ii(1), 0 /)
1557 npt_a = 3
1558 ENDIF
1559
1560!--CHECK ADJACENT ELEM ALREADY TREATED ( KK : CHECK_FLAG_ELEM(KK) = 1)
1561!need to get KK
1562 idx1 = iad_adj(jj)
1563 idx2 = iad_adj(jj+1)-1
1564 lfound_adj = .false.
1565 DO kk=idx1,idx2
1566 ielem_adj = list_adj_tab(kk)
1567 IF(check_flag_elem(ielem_adj) /= 0 )THEN
1568 lfound_adj = .true.
1569 EXIT
1570 ENDIF
1571 ENDDO
1572 IF(.NOT. lfound_adj)THEN
1573 print *, "**error when forcing monvol surface orientation"
1574 CALL arret(2);
1575 return;
1576 ENDIF
1577 kk = ielem_adj
1578!print *, "found adjacent element already treated =", IXTG(6, SURF%ELEM(KK) )
1579
1580!--LIST OF EDGES FOR ADJACENT ELEM
1581 IF (kk <= nseg) THEN
1582 ii(1:4) = surf%NODES(kk,1:4)
1583 ish34 = surf%ELTYP(kk)
1584 IF(ish34==3.AND.ii(3)/=ii(4))THEN
1585 edges_b(1:5)=(/ ii(1:4), ii(1) /)
1586 npt_b=4
1587 ELSE
1588 edges_b(1:5)=(/ ii(1:3), ii(1), 0 /)
1589 npt_b=3
1590 ENDIF
1591 ELSE
1592 ii(1:3) = t_monvoln%FILL_TRI(3 * (kk - nseg - 1) + 1 : 3 * (kk - nseg - 1) + 3)
1593 ii(4) = ii(3)
1594 edges_b(1:5) = (/ ii(1:3), ii(1), 0 /)
1595 npt_b = 3
1596 ENDIF
1597
1598!--CHECK PATTERN (CURRENT vs ADJACENT)
1599 lfound = .false.
1600 DO idx_a=1,npt_a
1601 DO idx_b=1,npt_b
1602 IF(edges_b(idx_b)==edges_a(idx_a))THEN
1603 IF(edges_b(idx_b+1)==edges_a(idx_a+1))THEN
1604 lfound = .true.
1605 EXIT
1606 ENDIF
1607 ENDIF
1608 ENDDO
1609 IF(lfound)EXIT
1610 ENDDO
1611
1612!--REVERSE IF NEEDED (CURRENT ELEM)
1613 IF(lfound)THEN
1614 IF (jj <= nseg) THEN
1615 ii(1:4) = surf%NODES(jj,1:4)
1616 IF(npt_a == 4)THEN
1617 surf%NODES(jj,1:4)=(/ ii(1), ii(4), ii(3), ii(2) /)
1618 ELSE
1619 surf%NODES(jj,1:4)=(/ ii(2), ii(1), ii(3), ii(4) /)
1620 ENDIF
1621 ELSE
1622 ii(1:3) = t_monvoln%FILL_TRI(3 * (jj - nseg - 1) + 1 : 3 * (jj - nseg - 1) + 3)
1623 ii(4) = ii(3)
1624 t_monvoln%FILL_TRI(3 * (jj - nseg - 1) + 1 : 3 * (jj - nseg - 1) + 3) = (/ ii(2), ii(1), ii(3) /)
1625 ENDIF
1626!print *, "--> reversed normal =", IXTG(6, SURF%ELEM(JJ) )
1627 nb_reversed = nb_reversed + 1
1628 check_flag_elem(jj)=-1
1629 ENDIF
1630
1631!MARK ELEM AS TREATED & NEXT
1632 check_flag_elem(jj)=1 !treated and unchanged
1633 IF(lfound)check_flag_elem(jj)=-1 !treated and reversed
1634
1635 ENDDO !next IELEM
1636 ENDDO
1637 ELSE
1638 CALL ancmsg(msgid = 1882, anmode = aninfo, msgtype = msgwarning,
1639 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
1640 ENDIF
1641
1642 !----------------------------------------------------!
1643 ! 10. CONSISTENT ORIENTATION OF DUPLICATED ELEMENTS
1644 !----------------------------------------------------!
1645 ALLOCATE(duplicated_elts(nb_duplicated_elts * 2))
1646 CALL tab1_get(duplicate_ptr, duplicated_elts)
1647 DO jj = 1, nb_duplicated_elts
1648 elem1id = surf%ELEM(duplicated_elts(2 * (jj - 1) + 1))
1649 elem2id = surf%ELEM(duplicated_elts(2 * (jj - 1) + 2))
1650! ELEM1D is already oriented, ELEM2ID has to be oriented reversely
1651 eltyp1 = surf%ELTYP(duplicated_elts(2 * (jj - 1) + 1))
1652 eltyp2 = surf%ELTYP(duplicated_elts(2 * (jj - 1) + 2))
1653 IF (eltyp1 == eltyp2) THEN
1654 ii(1:4) = surf%NODES(elem1id, 1:4)
1655 IF (eltyp1 == 7) THEN
1656! Triangles
1657 surf%NODES(elem2id, 1:4) = (/ ii(2), ii(1), ii(3), ii(4) /)
1658 ELSE
1659! Quads
1660 surf%NODES(elem2id, 1:4) = (/ ii(1), ii(4), ii(3), ii(2) /)
1661 ENDIF
1662 ELSE
1663! Target element is necessarily the triangle
1664 ii(1:4) = surf%NODES(elem2id,1:4)
1665 edges_a(1:5) = (/ ii(1:3), ii(1), 0 /)
1666 npt_a = 3
1667 ii(1:4) = surf%NODES(elem1id,1:4)
1668 edges_b(1:5) = (/ ii(1:4), ii(1) /)
1669 npt_b = 4
1670 !--CHECK PATTERN (CURRENT vs ADJACENT)
1671 lfound = .false.
1672 DO idx_a=1,npt_a
1673 DO idx_b=1,npt_b
1674 IF(edges_b(idx_b)==edges_a(idx_a))THEN
1675 IF(edges_b(idx_b+1)==edges_a(idx_a+1))THEN
1676 lfound = .true.
1677 EXIT
1678 ENDIF
1679 ENDIF
1680 ENDDO
1681 IF(lfound)EXIT
1682 ENDDO
1683 IF(lfound)THEN
1684 ii(1:4) = surf%NODES(elem2id, 1:4)
1685 IF(npt_a == 4)THEN
1686 surf%NODES(elem2id,1:4)=(/ ii(1), ii(4), ii(3), ii(2) /)
1687 ELSE
1688 surf%NODES(elem2id,1:4)=(/ ii(2), ii(1), ii(3), ii(4) /)
1689 ENDIF
1690 ENDIF
1691 ENDIF
1692 ENDDO
1693 CALL tab1_free_memory(duplicate_ptr)
1694
1695 !-------------------------------------!
1696 ! 11. DEBUG OUTPUT : RESULT ON SCREEN !
1697 !-------------------------------------!
1698 !--display on screen the element path (possible mixed SHELL,SH3N)
1699 debug_output=.false.
1700 if(debug_output)then
1701 icomp=1
1702 ALLOCATE(db_path(sizes(icomp)))
1703 do ielem=1,sizes(icomp)
1704 jj=1+paths(ielem)
1705 ii(1:4) = surf%NODES(jj,1:4)
1706 ish34 = surf%ELTYP(jj)
1707 IF(ish34==3.AND.ii(3)/=ii(4))THEN
1708 db_path(jj) = ixc(7,surf%ELEM((jj)))
1709 else
1710 db_path(jj) = ixtg(6,surf%ELEM((jj)))
1711 endif
1712 enddo
1713 print *,"____________________________________________________"
1714 print *, "there are ",sizes(icomp)," elements along the path"
1715 print *, db_path(1:sizes(icomp))
1716 print *,"____________________________________________________"
1717 deallocate(db_path)
1718 endif !debug_output
1719
1720 debug_output=.false.
1721 if(debug_output)then
1722 !--display on screen the reversed elems (possible mixed SHELL,SH3N)
1723 idx=0
1724 ALLOCATE(db_reversed(sizes(icomp)))
1725 do ielem=1,sizes(icomp)
1726 jj=1+paths(ielem)
1727 ii(1:4) = surf%NODES(jj,1:4)
1728 ish34 = surf%ELTYP(jj)
1729 IF(check_flag_elem(jj)==-1)THEN
1730 idx=idx+1
1731 IF(ish34==3.AND.ii(3)/=ii(4))THEN
1732 db_reversed(idx) = ixc(7,surf%ELEM((jj)))
1733 else
1734 db_reversed(idx) = ixtg(6,surf%ELEM((jj)))
1735 endif
1736 ENDIF
1737 enddo
1738 print *, "there were ",nb_reversed," element(s) reversed along the path"
1739 print *, db_reversed(1:nb_reversed)
1740 print *,"____________________________________________________"
1741 DEALLOCATE(db_reversed)
1742 endif !debug_output
1743
1744 !------------------------------------!
1745 ! 8. FREE MEMORY !
1746 !------------------------------------!
1747 IF(ALLOCATED(nb_adj))DEALLOCATE(nb_adj)
1748 IF(ALLOCATED(iad_adj))DEALLOCATE(iad_adj)
1749 IF(ALLOCATED(check_flag_elem))DEALLOCATE(check_flag_elem)
1750 IF(ALLOCATED(list_adj_tab))DEALLOCATE(list_adj_tab)
1751 IF(ALLOCATED(paths))DEALLOCATE(paths)
1752 IF(ALLOCATED(sizes))DEALLOCATE(sizes)
1753 IF(ALLOCATED(duplicated_elts)) DEALLOCATE(duplicated_elts)
1754 IF(ALLOCATED(pair_list)) DEALLOCATE(pair_list)
1755 IF(ALLOCATED(nb_pair_by_edge)) DEALLOCATE(nb_pair_by_edge)
1756 IF (ALLOCATED(iad_comp_connex)) DEALLOCATE(iad_comp_connex)
1757 CALL graph_free_memory(graph_ptr)
1758
1759
my_real
#define my_real
Definition cppsort.cpp:32
monvol_build_edges
subroutine monvol_build_edges(t_monvoln, surf)
Definition monvol_struct_mod.F:1908
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87

◆ monvol_reverse_normals()

subroutine monvol_reverse_normals ( type(monvol_struct_), intent(inout) t_monvoln,
character(len = nchartitle), intent(in) title,
integer, dimension(nimv), intent(in) ivolu,
integer, dimension(*), intent(in) itab,
type(surf_), intent(inout) surf,
integer, dimension(nixc, numelc), intent(in) ixc,
integer, dimension(nixtg, numeltg), intent(in) ixtg,
intent(inout) vol,
dimension(3,numnod), intent(in) x,
integer, intent(in) itype )

Definition at line 1779 of file monvol_struct_mod.F.

1780C-----------------------------------------------
1781C D e s c r i p t i o n
1782C-----------------------------------------------
1783C This subroutine reverse all normals composing a given surface.
1784C Pre-condition : volume must be negative, otherwise normal are consider
1785C to be correctly oriented.
1786C-----------------------------------------------
1787C M o d u l e s
1788C-----------------------------------------------
1789 USE groupdef_mod
1790 USE message_mod
1791 USE monvol_struct_mod
1792C-----------------------------------------------
1793C I m p l i c i t T y p e s
1794C-----------------------------------------------
1795#include "implicit_f.inc"
1796C-----------------------------------------------
1797C C o m m o n B l o c k s
1798C-----------------------------------------------
1799#include "param_c.inc"
1800#include "com04_c.inc"
1801C-----------------------------------------------
1802C D u m m y A r g u m e n t s
1803C-----------------------------------------------
1804 CHARACTER(LEN = nchartitle), INTENT(IN) :: TITLE
1805 INTEGER, INTENT(IN) :: IVOLU(NIMV), ITAB(*), ITYPE
1806 TYPE(SURF_), INTENT(INOUT) :: SURF
1807 my_real, INTENT(INOUT) :: vol
1808 my_real, INTENT(IN) :: x(3,numnod)
1809 INTEGER,INTENT(IN) :: IXC(NIXC, NUMELC), IXTG(NIXTG, NUMELTG)
1810 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
1811C-----------------------------------------------
1812C L o c a l v a r i a b l e s
1813C-----------------------------------------------
1814 INTEGER JJ,ISH34,II(4),KK,NSEG
1815 CHARACTER(LEN=1024) :: FILENAME
1816 LOGICAL debug_output
1817C-----------------------------------------------
1818C P r e C o n d i t i o n
1819C-----------------------------------------------
1820! nothing to do if vol>0.0, normal are already correctly oriented.
1821C IF(VOL > ZERO) RETURN !commented to get debug output (surf in file)
1822C-----------------------------------------------
1823C S o u r c e L i n e s
1824C-----------------------------------------------
1825
1826 IF (.NOT. t_monvoln%OK_REORIENT) RETURN
1827 nseg = surf%NSEG
1828 IF(vol<zero)THEN
1829!print *, "VOLUME IS NEGATIVE, SURFACE IS REVERTED" .
1830 vol = -vol
1831 DO jj=1,nseg
1832 ish34 = surf%ELTYP(jj)
1833 ii(1:4) = surf%NODES(jj,1:4)
1834 IF(ish34 == 3)THEN
1835!SHELL
1836 surf%NODES(jj,1:4)=(/ ii(1), ii(4), ii(3), ii(2) /)
1837 ELSEIF(ish34 == 7)THEN
1838!SH3N
1839 surf%NODES(jj,1:4)=(/ ii(2), ii(1), ii(3), ii(4) /)
1840 ENDIF
1841 ENDDO
1842 DO jj = 1, t_monvoln%NB_FILL_TRI
1843 ii(1:3) = t_monvoln%FILL_TRI(3 * (jj - 1) + 1 : 3 * (jj - 1) + 3)
1844 ii(4) = ii(3)
1845 t_monvoln%FILL_TRI(3 * (jj - 1) + 1 : 3 * (jj - 1) + 3) = (/ ii(2), ii(1), ii(3) /)
1846 ENDDO
1847 ENDIF
1848
1849 !------------------------------------!
1850 ! 7. DEBUG OUTPUT : SURF IN FILE !
1851 !------------------------------------!
1852 !--write a Radioss input file to check final surface
1853 debug_output=.false.
1854 if(debug_output)then
1855 nseg=surf%NSEG
1856 WRITE(filename, "(A,I0,A)") "surfmesh_after_",t_monvoln%ID,"_0000.rad"
1857 OPEN(unit = 210486, file = trim(filename), form ='formatted')
1858 WRITE(210486, '(A)') "#RADIOSS STARTER"
1859 WRITE(210486, '(A)') "/BEGIN"
1860 WRITE(210486, '(A)') "ORIENTED_SURFACE "
1861 WRITE(210486, '(A)') " 100 0"
1862 WRITE(210486, '(A)') " g mm ms"
1863 WRITE(210486, '(A)') " g mm ms"
1864 WRITE(210486, "(A5)") "/NODE"
1865 DO kk = 1, numnod
1866 WRITE(210486, "(I10, 1PG20.13, 1PG20.13, 1PG20.13)") itab(kk),x(1, kk), x(2, kk), x(3, kk)
1867 ENDDO
1868 DO kk = 1, nseg
1869 ii(1:4) = surf%NODES(kk,1:4)
1870 ish34 = surf%ELTYP(kk)
1871 IF (ish34 == 3) THEN
1872 WRITE(210486, "(A6)") "/SHELL"
1873 WRITE(210486, '(I10,I10,I10,I10,I10)') ixc(7,surf%ELEM(kk)), itab(ii(1)), itab(ii(2)),itab(ii(3)), itab(ii(4))
1874 ENDIF
1875 ENDDO
1876 DO kk = 1, nseg
1877 ii(1:4) = surf%NODES(kk,1:4)
1878 ish34 = surf%ELTYP(kk)
1879 IF (ish34 == 7) THEN
1880 WRITE(210486, "(A5)") "/SH3N"
1881 WRITE(210486, '(I10,I10,I10,I10)') ixtg(6,surf%ELEM(kk)), itab(ii(1)), itab(ii(2)),itab(ii(3))
1882 ENDIF
1883 ENDDO
1884 IF (t_monvoln%NB_FILL_TRI > 0) THEN
1885 WRITE(210486, "(A5)") "/SH3N"
1886 ENDIF
1887 DO kk = 1, t_monvoln%NB_FILL_TRI
1888 WRITE(210486, '(I10,I10,I10,I10)') kk + nseg, itab(t_monvoln%FILL_TRI(3 * (kk - 1) + 1)),
1889 . itab(t_monvoln%FILL_TRI(3 * (kk - 1) + 2)), itab(t_monvoln%FILL_TRI(3 * (kk - 1) + 3))
1890 ENDDO
1891 CLOSE (210486)
1892 endif !debug_output
1893