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 1911 of file monvol_struct_mod.F.

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

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

◆ 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 1782 of file monvol_struct_mod.F.

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