OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
monvol_struct_mod Module Reference

Data Types

type  monvol_metadata_
type  monvol_struct_
type  monvol_omp_

Functions/Subroutines

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

Function/Subroutine Documentation

◆ copy_to_monvol()

subroutine monvol_struct_mod::copy_to_monvol ( type(monvol_struct_), dimension(nvolu), intent(in) t_monvol,
integer, intent(in) licbag,
integer, dimension(licbag), intent(in) icbag,
integer, intent(in) smonvol,
integer, dimension(smonvol), intent(inout) monvol )

Definition at line 162 of file monvol_struct_mod.F.

163C-----------------------------------------------
164C I m p l i c i t T y p e s
165C-----------------------------------------------
166#include "implicit_f.inc"
167C-----------------------------------------------
168C C o m m o n B l o c k s
169C-----------------------------------------------
170#include "param_c.inc"
171#include "com04_c.inc"
172C-----------------------------------------------
173C D u m m y A r g u m e n t s
174C-----------------------------------------------
175 INTEGER, INTENT(IN) :: SMONVOL, LICBAG
176 INTEGER, DIMENSION(LICBAG), INTENT(IN) :: ICBAG
177 INTEGER, DIMENSION(SMONVOL), INTENT(INOUT) :: MONVOL
178 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(IN) :: T_MONVOL
179C-----------------------------------------------
180C L o c a l v a r i a b l e s
181C-----------------------------------------------
182 INTEGER :: II, JJ, KK, I, ICOPY, N
183 INTEGER :: NVENT
184 INTEGER :: SHIFT
185
186 shift = licbag
187 DO n = 1, nvolu
188 shift = shift + nimv
189 shift = shift + nibjet * t_monvol(n)%NJET
190 shift = shift + nibhol * t_monvol(n)%NVENT
191 ENDDO
192
193 i = 1
194 DO ii = 1, nvolu
195 DO jj = 1, nimv
196 monvol(i) = t_monvol(ii)%IVOLU(jj)
197 i = i + 1
198 ENDDO
199 ENDDO
200 monvol(i:i + licbag - 1) = icbag(1:licbag)
201 i = i + licbag
202 DO ii = 1, nvolu
203 DO jj = 1, t_monvol(ii)%NJET
204 DO kk = 1, nibjet
205 monvol(i) = t_monvol(ii)%IBAGJET(kk, jj)
206 i = i + 1
207 ENDDO
208 ENDDO
209 ENDDO
210 DO ii = 1, nvolu
211 nvent = t_monvol(ii)%NVENT
212 DO jj = 1, nvent
213 DO kk = 1, nibhol
214 monvol(i) = t_monvol(ii)%IBAGHOL(kk, jj)
215 i = i + 1
216 ENDDO
217 ENDDO
218 ENDDO
219 icopy = i
220 DO n = 1, nvolu
221 IF (t_monvol(n)%TYPE == 6 .OR. t_monvol(n)%TYPE == 8) THEN
222 icopy = shift + t_monvol(n)%IADALE
223 ENDIF
224 DO i = 1, t_monvol(n)%NNS + t_monvol(n)%NNI
225 monvol(icopy) = t_monvol(n)%NODES(i)
226 icopy = icopy + 1
227 ENDDO
228 DO i = 1, t_monvol(n)%NTG + t_monvol(n)%NTGI
229 monvol(icopy) = t_monvol(n)%ELEM(1, i)
230 icopy = icopy + 1
231 monvol(icopy) = t_monvol(n)%ELEM(2, i)
232 icopy = icopy + 1
233 monvol(icopy) = t_monvol(n)%ELEM(3, i)
234 icopy = icopy + 1
235 ENDDO
236 DO i = 1, t_monvol(n)%NTG + t_monvol(n)%NTGI
237 monvol(icopy) = t_monvol(n)%ITAGEL(i)
238 icopy = icopy + 1
239 ENDDO
240 DO i = 1, t_monvol(n)%NTG + t_monvol(n)%NTGI
241 monvol(icopy) = t_monvol(n)%ELTG(i)
242 icopy = icopy + 1
243 ENDDO
244 DO i = 1, t_monvol(n)%NTG + t_monvol(n)%NTGI
245 monvol(icopy) = t_monvol(n)%MATTG(i)
246 icopy = icopy + 1
247 ENDDO
248 DO i = 1, t_monvol(n)%NBRIC
249 DO ii = 1, 2
250 monvol(icopy) = t_monvol(n)%TBRIC(ii, i)
251 icopy = icopy + 1
252 ENDDO
253 ENDDO
254 DO i = 1, t_monvol(n)%NBRIC
255 DO ii = 1, 12
256 monvol(icopy) = t_monvol(n)%TFAC(ii, i)
257 icopy = icopy + 1
258 ENDDO
259 ENDDO
260 DO i = 1, t_monvol(n)%NTG + 2 * t_monvol(n)%NTGI
261 monvol(icopy) = t_monvol(n)%TAGELS(i)
262 icopy = icopy + 1
263 ENDDO
264 icopy = t_monvol(n)%IADALE8 + shift
265 IF (t_monvol(n)%IADALE8 == 0) icopy = icopy + 1
266 DO i = 1, t_monvol(n)%NNA
267 monvol(icopy) = t_monvol(n)%IBUFA(i)
268 icopy = icopy + 1
269 ENDDO
270 IF (t_monvol(n)%NBRIC == 0) THEN
271 icopy = t_monvol(n)%IADALE9 + shift
272 IF (t_monvol(n)%IADALE9 == 0) icopy = icopy + 1
273 ENDIF
274 DO i = 1, t_monvol(n)%NTGA
275 DO ii = 1, 3
276 monvol(icopy) = t_monvol(n)%ELEMA(ii, i)
277 icopy = icopy + 1
278 ENDDO
279 ENDDO
280 DO i = 1, t_monvol(n)%NTGA
281 monvol(icopy) = t_monvol(n)%TAGELA(i)
282 icopy = icopy + 1
283 ENDDO
284 DO i = 1, t_monvol(n)%NBRIC
285 DO ii = 1, 8
286 monvol(icopy) = t_monvol(n)%BRNA(ii, i)
287 icopy = icopy + 1
288 ENDDO
289 ENDDO
290 DO i = 1, t_monvol(n)%NNA
291 DO ii = 1, 16
292 monvol(icopy) = t_monvol(n)%NCONA(ii, i)
293 icopy = icopy + 1
294 ENDDO
295 ENDDO
296 IF (t_monvol(n)%NTGI > 0) THEN
297 DO jj = 1, nsurf
298 DO i = 1, t_monvol(n)%NTGI + 1
299 monvol(icopy) = t_monvol(n)%THSURF_TAG(jj, i)
300 icopy = icopy + 1
301 ENDDO
302 ENDDO
303 ENDIF
304 ENDDO
icopy
subroutine icopy(n, sx, incx, sy, incy)
ICOPY
Definition icopy.f:75

◆ copy_to_volmon()

subroutine monvol_struct_mod::copy_to_volmon ( type(monvol_struct_), dimension(nvolu), intent(in) t_monvol,
integer, intent(in) lrcbag,
intent(in) rcbag,
integer, intent(in) svolmon,
intent(inout) volmon )

Definition at line 312 of file monvol_struct_mod.F.

313C-----------------------------------------------
314C I m p l i c i t T y p e s
315C-----------------------------------------------
316#include "implicit_f.inc"
317C-----------------------------------------------
318C C o m m o n B l o c k s
319C-----------------------------------------------
320#include "param_c.inc"
321#include "com04_c.inc"
322C-----------------------------------------------
323C D u m m y A r g u m e n t s
324C-----------------------------------------------
325 INTEGER, INTENT(IN) :: SVOLMON, LRCBAG
326 my_real, DIMENSION(LRCBAG), INTENT(IN) :: rcbag
327 my_real, DIMENSION(SVOLMON), INTENT(INOUT) :: volmon
328 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(IN) :: T_MONVOL
329C-----------------------------------------------
330C L o c a l v a r i a b l e s
331C-----------------------------------------------
332 INTEGER :: II, JJ, KK, I, ICOPY
333 INTEGER :: NVENT, NJET
334! ***** !
335! RVOLU !
336! ***** !
337 icopy = 1
338 DO ii = 1, nvolu
339 DO jj = 1, nrvolu
340 volmon(icopy) = t_monvol(ii)%RVOLU(jj)
341 icopy = icopy + 1
342 ENDDO
343 ENDDO
344 DO i = 1, lrcbag
345 volmon(icopy) = rcbag(i)
346 icopy = icopy + 1
347 ENDDO
348
349 DO ii = 1, nvolu
350 njet = t_monvol(ii)%NJET
351 DO jj = 1, njet
352 DO kk = 1, nrbjet
353 volmon(icopy) = t_monvol(ii)%RBAGJET(kk, jj)
354 icopy = icopy + 1
355 ENDDO
356 ENDDO
357 ENDDO
358! RBAGHOL
359 DO ii = 1, nvolu
360 nvent = t_monvol(ii)%NVENT
361 DO jj = 1, nvent
362 DO kk = 1, nrbhol
363 volmon(icopy) = t_monvol(ii)%RBAGHOL(kk, jj)
364 icopy = icopy + 1
365 ENDDO
366 ENDDO
367 ENDDO
368
369! ******* !
370! BUFALER !
371! ******* !
372 DO ii = 1, nvolu
373! Velocities and node coordinates
374 IF (t_monvol(ii)%KR5 > 0) THEN
375 icopy = t_monvol(ii)%KR5
376 DO jj = 1, t_monvol(ii)%NTG + t_monvol(ii)%NTGI
377 volmon(icopy) = t_monvol(ii)%ELAREA(jj)
378 icopy = icopy + 1
379 ENDDO
380 ENDIF
381 IF (t_monvol(ii)%KRA5 > 0) THEN
382 icopy = t_monvol(ii)%KRA5
383 DO jj = 1, t_monvol(ii)%NNA
384 volmon(icopy) = t_monvol(ii)%NODE_COORD(1, jj)
385 icopy = icopy + 1
386 volmon(icopy) = t_monvol(ii)%NODE_COORD(2, jj)
387 icopy = icopy + 1
388 volmon(icopy) = t_monvol(ii)%NODE_COORD(3, jj)
389 icopy = icopy + 1
390 ENDDO
391 icopy = icopy + 3 * t_monvol(ii)%NNA
392 DO jj = 1, t_monvol(ii)%NTGI
393 volmon(icopy) = t_monvol(ii)%POROSITY(jj)
394 icopy = icopy + 1
395 ENDDO
396 ENDIF
397 ENDDO
my_real
#define my_real
Definition cppsort.cpp:32

◆ monvol_allocate()

subroutine monvol_struct_mod::monvol_allocate ( integer, intent(in) nvolu,
type(monvol_struct_), dimension(nvolu), intent(inout) t_monvol,
type(monvol_metadata_), intent(inout) t_monvol_metadata )

Definition at line 958 of file monvol_struct_mod.F.

959C-----------------------------------------------
960C I m p l i c i t T y p e s
961C-----------------------------------------------
962#include "implicit_f.inc"
963#include "param_c.inc"
964C-----------------------------------------------
965C D u m m y A r g u m e n t s
966C-----------------------------------------------
967 INTEGER, INTENT(IN) :: NVOLU
968 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(INOUT) :: T_MONVOL
969 TYPE(MONVOL_METADATA_), INTENT(INOUT) :: T_MONVOL_METADATA
970C-----------------------------------------------
971C L o c a l V a r i a b l e s
972C-----------------------------------------------
973 INTEGER :: II
974
975 ! ----------------------------------
976 ! initialization of T_MONVOL
977 t_monvol(1:nvolu)%TYPE = 0
978 t_monvol(1:nvolu)%ID = 0
979 t_monvol(1:nvolu)%NCA = 0
980 t_monvol(1:nvolu)%EXT_SURFID = 0
981 t_monvol(1:nvolu)%INT_SURFID = 0
982 t_monvol(1:nvolu)%NJET = 0
983 t_monvol(1:nvolu)%NVENT = 0
984 t_monvol(1:nvolu)%NPORSURF = 0
985 t_monvol(1:nvolu)%NNS = 0
986 t_monvol(1:nvolu)%NNI = 0
987 t_monvol(1:nvolu)%NTG = 0
988 t_monvol(1:nvolu)%NTGI = 0
989 t_monvol(1:nvolu)%NBRIC = 0
990 t_monvol(1:nvolu)%NNA = 0
991 t_monvol(1:nvolu)%NTGA = 0
992 t_monvol(1:nvolu)%IMESH_ALL = 0
993 t_monvol(1:nvolu)%KMESH = 0
994 t_monvol(1:nvolu)%NB_FILL_TRI = 0
995 t_monvol(1:nvolu)%NEDGE = 0
996 t_monvol(1:nvolu)%IADALE = 0
997 t_monvol(1:nvolu)%IADALE2 = 0
998 t_monvol(1:nvolu)%IADALE3 = 0
999 t_monvol(1:nvolu)%IADALE4 = 0
1000 t_monvol(1:nvolu)%IADALE5 = 0
1001 t_monvol(1:nvolu)%IADALE6 = 0
1002 t_monvol(1:nvolu)%IADALE7 = 0
1003 t_monvol(1:nvolu)%IADALE8 = 0
1004 t_monvol(1:nvolu)%IADALE9 = 0
1005 t_monvol(1:nvolu)%IADALE10 = 0
1006 t_monvol(1:nvolu)%IADALE11 = 0
1007 t_monvol(1:nvolu)%IADALE12 = 0
1008 t_monvol(1:nvolu)%IADALE13 = 0
1009 t_monvol(1:nvolu)%KRA5 = 0
1010 t_monvol(1:nvolu)%KRA6 = 0
1011 t_monvol(1:nvolu)%KR5 = 0
1012 ! ----------------------------------
1013
1014 t_monvol_metadata%NVOLU = nvolu
1015 ALLOCATE(t_monvol_metadata%ICBAG(nicbag, nvolu * nvolu))
1016 ALLOCATE(t_monvol_metadata%RCBAG(nrcbag, nvolu * nvolu))
1017 t_monvol_metadata%RCBAG(:, :) = zero
1018 t_monvol_metadata%ICBAG(:, :) = 0
1019 DO ii = 1, nvolu
1020 ALLOCATE(t_monvol(ii)%IVOLU(nimv))
1021 t_monvol(ii)%IVOLU(1:nimv) = 0
1022 ALLOCATE(t_monvol(ii)%RVOLU(nrvolu))
1023 t_monvol(ii)%RVOLU(1:nrvolu) = zero
1024 t_monvol(ii)%NVENT = 0
1025 t_monvol(ii)%NPORSURF = 0
1026 t_monvol(ii)%EXT_SURFID = 0
1027 t_monvol(ii)%INT_SURFID = 0
1028 t_monvol(ii)%NCA = 0
1029 t_monvol(ii)%KR5 = 0
1030 t_monvol(ii)%KRA5 = 0
1031 t_monvol(ii)%EDGES_BUILT = .false.
1032 t_monvol(ii)%NB_FILL_TRI = 0
1033 t_monvol(ii)%OK_REORIENT = .true.
1034 ENDDO

◆ monvol_check_surfclose()

subroutine monvol_struct_mod::monvol_check_surfclose ( type(monvol_struct_), intent(inout) t_monvoln,
integer, dimension(*), intent(in) itab,
type(surf_), intent(in) surf,
dimension(3, *), intent(in) x )

Definition at line 420 of file monvol_struct_mod.F.

421C-----------------------------------------------
422C M o d u l e s
423C-----------------------------------------------
424 USE groupdef_mod
425 USE message_mod
426C-----------------------------------------------
427C I m p l i c i t T y p e s
428C-----------------------------------------------
429#include "implicit_f.inc"
430C-----------------------------------------------
431C C o m m o n B l o c k s
432C-----------------------------------------------
433C NSURF
434#include "com04_c.inc"
435C NIMV
436#include "param_c.inc"
437C nchartitle
438#include "scr17_c.inc"
439C IOUT
440#include "units_c.inc"
441C-----------------------------------------------
442C D u m m y A r g u m e n t s
443C-----------------------------------------------
444 INTEGER, INTENT(IN) :: ITAB(*)
445 TYPE(SURF_), INTENT(IN) :: SURF
446 TYPE(MONVOL_STRUCT_), INTENT(INOUT) :: T_MONVOLN
447 my_real, INTENT(IN) :: x(3, *)
448C-----------------------------------------------
449C L o c a l V a r i a b l e s
450C-----------------------------------------------
451 INTEGER :: JJ, NEDGE, NELEM, IEDGE, NODE1, NODE2, INODE
452 INTEGER :: NB_FREE_EDGE
453 INTEGER(8) :: graph_ptr, tri_ptr, tri_ptr_global
454 INTEGER, DIMENSION(:), ALLOCATABLE :: FREE_EDGES_ID, FREE_EDGES, LOCAL_NODE_ID, GLOBAL_NODE_ID
455 INTEGER :: NB_CONNECTED_COMPS, TOTAL_SIZE, II
456 INTEGER, DIMENSION(:), ALLOCATABLE :: PATHS, SIZES, CYCLES, SHIFT
457 INTEGER :: NPT,NTRI
458 my_real, DIMENSION(:), ALLOCATABLE :: node_coord
459 INTEGER, DIMENSION(:), ALLOCATABLE :: TRI_LIST
460 !CHARACTER(LEN=1024) :: FILENAME
461C-----------------------------------------------
462C B e g i n n i n g o f s o u r c e
463C-----------------------------------------------
464
465! ******************** !
466! ** Initialization ** !
467! ******************** !
468 graph_ptr = 0
469 tri_ptr = 0
470 tri_ptr_global = 0
471
472! ***************************** !
473! ** Build edge connectivity ** !
474! ***************************** !
475 CALL monvol_build_edges(t_monvoln, surf)
476
477! ************************* !
478! ** Identify free edges ** !
479! ************************* !
480 nedge = t_monvoln%NEDGE
481 nb_free_edge = 0
482 DO jj = 1, nedge
483 nelem = t_monvoln%IAD_EDGE_ELEM(jj + 1) - t_monvoln%IAD_EDGE_ELEM(jj)
484 IF (nelem == 1) THEN
485 nb_free_edge = nb_free_edge + 1
486 ENDIF
487 ENDDO
488
489! ************************ !
490! ** Recover free edges ** !
491! ************************ !
492 IF (nb_free_edge > 0) THEN
493 ALLOCATE(free_edges_id(nb_free_edge))
494 ALLOCATE(free_edges(2 * nb_free_edge))
495 ALLOCATE(local_node_id(numnod))
496 local_node_id(1:numnod) = 0
497 iedge = 0
498 inode = 0
499 DO jj = 1, nedge
500 nelem = t_monvoln%IAD_EDGE_ELEM(jj + 1) - t_monvoln%IAD_EDGE_ELEM(jj)
501 IF (nelem == 1) THEN
502 iedge = iedge + 1
503 node1 = t_monvoln%EDGE_NODE1(jj)
504 node2 = t_monvoln%EDGE_NODE2(jj)
505 free_edges(2 * (iedge - 1) + 1) = node1
506 free_edges(2 * (iedge - 1) + 2) = node2
507 IF (local_node_id(node1) == 0) THEN
508 inode = inode + 1
509 local_node_id(node1) = inode
510 ENDIF
511 IF (local_node_id(node2) == 0) THEN
512 inode = inode + 1
513 local_node_id(node2) = inode
514 ENDIF
515 ENDIF
516 ENDDO
517 ALLOCATE(global_node_id(inode))
518 DO ii = 1, numnod
519 IF(local_node_id(ii) > 0) THEN
520 global_node_id(local_node_id(ii)) = ii
521 ENDIF
522 ENDDO
523! change edges node id to local node id
524 DO iedge = 1, nb_free_edge
525 free_edges(2 * (iedge - 1) + 1) = local_node_id(free_edges(2 * (iedge - 1) + 1)) - 1
526 free_edges(2 * (iedge - 1) + 2) = local_node_id(free_edges(2 * (iedge - 1) + 2)) - 1
527 ENDDO
528 CALL graph_build_path(inode, nb_free_edge, free_edges,
529 . nb_connected_comps, graph_ptr)
530
531 ALLOCATE(sizes(nb_connected_comps), cycles(nb_connected_comps))
532 CALL graph_build_cycles(graph_ptr, cycles)
533 CALL graph_get_sizes(graph_ptr, sizes)
534 total_size = 0
535 ALLOCATE(shift(nb_connected_comps + 1))
536 shift(1) = 0
537 DO ii = 1, nb_connected_comps
538 shift(ii + 1) = shift(ii) + sizes(ii)
539 total_size = total_size + sizes(ii)
540 ENDDO
541 ALLOCATE(paths(total_size))
542 CALL graph_get_path(graph_ptr, paths)
543 CALL graph_free_memory(graph_ptr)
544
545 CALL tab1_init(tri_ptr_global)
546#ifdef DNC
547 DO ii = 1, nb_connected_comps
548 IF (cycles(ii) == 0) THEN
549! The connected component is not a hole -> cannot be closed
550 cycle
551 ENDIF
552 npt = sizes(ii)
553 ALLOCATE(node_coord(3 * npt))
554 DO jj = 1, npt
555 node_coord(3 * (jj - 1) + 1) = x(1, global_node_id(1+paths(jj + shift(ii))))
556 node_coord(3 * (jj - 1) + 2) = x(2, global_node_id(1+paths(jj + shift(ii))))
557 node_coord(3 * (jj - 1) + 3) = x(3, global_node_id(1+paths(jj + shift(ii))))
558 ENDDO
559 CALL hm_fill_loop(npt, node_coord, ntri, tri_ptr)
560 ALLOCATE(tri_list(3 * ntri))
561 CALL hm_fill_loop_get_tri(tri_list, tri_ptr)
562 DO jj = 1, 3 * ntri
563 tri_list(jj) = global_node_id(1+paths(shift(ii) + tri_list(jj) + 1))
564 ENDDO
565 CALL tri_free_memory(tri_ptr)
566 CALL tab1_append_tab(tri_ptr_global, 3 * ntri, tri_list)
567 DEALLOCATE(tri_list)
568 DEALLOCATE(node_coord)
569 ENDDO
570#endif
571
572 CALL tab1_get_size(tri_ptr_global, ntri)
573 IF (ntri > 0) THEN
574 t_monvoln%NB_FILL_TRI = ntri / 3
575 ALLOCATE(t_monvoln%FILL_TRI(ntri))
576 WRITE(iout, 1000) nb_free_edge, nb_connected_comps
577 WRITE(iout, 1001) t_monvoln%NB_FILL_TRI
578 CALL tab1_get(tri_ptr_global, t_monvoln%FILL_TRI)
579 CALL tab1_free_memory(tri_ptr_global)
580
581! **************************************** !
582! ** Build edge connectivity once again ** !
583! **************************************** !
584 CALL monvol_build_edges(t_monvoln, surf)
585
586! ************************* !
587! ** Identify free edges ** !
588! ************************* !
589 nedge = t_monvoln%NEDGE
590 nb_free_edge = 0
591 DO jj = 1, nedge
592 nelem = t_monvoln%IAD_EDGE_ELEM(jj + 1) - t_monvoln%IAD_EDGE_ELEM(jj)
593 IF (nelem == 1) THEN
594 nb_free_edge = nb_free_edge + 1
595 ENDIF
596 ENDDO
597
598 IF (nb_free_edge > 0) THEN
599 CALL ancmsg(msgid = 1875, anmode = aninfo, msgtype = msgwarning,
600 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
601 WRITE(iout, 1002) nb_free_edge
602 ENDIF
603 ELSE
604 IF (nb_free_edge > 0) THEN
605 CALL ancmsg(msgid = 1875, anmode = aninfo, msgtype = msgwarning,
606 . i1 = t_monvoln%ID, c1 = t_monvoln%TITLE)
607 WRITE(iout, 1002) nb_free_edge
608 ENDIF
609 ENDIF
610 ENDIF
611! ************************* !
612! ** Memory deallocation ** !
613! ************************* !
614 IF (ALLOCATED(free_edges_id)) DEALLOCATE(free_edges_id)
615 IF (ALLOCATED(free_edges)) DEALLOCATE(free_edges)
616 IF (ALLOCATED(local_node_id)) DEALLOCATE(local_node_id)
617 IF (ALLOCATED(global_node_id)) DEALLOCATE(global_node_id)
618 IF (ALLOCATED(sizes)) DEALLOCATE(sizes)
619 IF (ALLOCATED(shift)) DEALLOCATE(shift)
620 IF (ALLOCATED(paths)) DEALLOCATE(paths)
621 IF (ALLOCATED(cycles)) DEALLOCATE(cycles)
622C-----------------------------------------------
623C E n d o f s o u r c e
624C-----------------------------------------------
625 1000 FORMAT(
626 . /5x,'EXTERNAL SURFACE OF THE MONITORED VOLUME IS NOT A CLOSED SURFACE',
627 . /5x, ' NUMBER OF FREE EDGES: ',i10,
628 . /5x, ' NUMBER OF HOLES: ', i10)
629 1001 FORMAT(
630 . 5x,' ----> AUTOMATIC CLOSURE ACTIVATED'
631 . /5x,' ----> SURFACE CLOSE WITH: ',i10,' TRIANGLES')
632 1002 FORMAT(
633 . /5x, ' NUMBER OF REMAINING FREE EDGES: ',i10)
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
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

◆ monvol_check_venthole_surf()

subroutine monvol_struct_mod::monvol_check_venthole_surf ( integer, intent(in) ipri,
type(monvol_struct_), intent(in) t_monvoln,
type (surf_), dimension(nsurf), intent(in) igrsurf,
integer, intent(in) ihol,
intent(out) shol,
dimension(3, *), intent(in) x,
integer, dimension(nixc, *), intent(in) ixc,
integer, dimension(nixtg, *), intent(in) ixtg )

Definition at line 796 of file monvol_struct_mod.F.

797 USE groupdef_mod
798 USE message_mod
799 use element_mod , only : nixc,nixtg
800C-----------------------------------------------
801C I m p l i c i t T y p e s
802C-----------------------------------------------
803#include "implicit_f.inc"
804#include "units_c.inc"
805#include "param_c.inc"
806#include "com04_c.inc"
807C-----------------------------------------------
808C D u m m y A r g u m e n t s
809C-----------------------------------------------
810 TYPE(MONVOL_STRUCT_), INTENT(IN) :: T_MONVOLN
811 INTEGER, INTENT(IN) :: IHOL, IPRI
812 INTEGER, INTENT(IN) :: IXC(NIXC, *), IXTG(NIXTG, *)
813 my_real, INTENT(IN) :: x(3, *)
814 my_real, INTENT(OUT) :: shol
815 TYPE (SURF_), DIMENSION(NSURF), INTENT(IN) :: IGRSURF
816C-----------------------------------------------
817C L o c a l V a r i a b l e s
818C-----------------------------------------------
819 INTEGER :: ISUR, IPVENT, NN, J
820 my_real :: dir, xx, yy, zz, x13, y13, z13, x24, y24, z24,
821 . nx, ny, nz, ds
822 INTEGER :: I1, I2, I3, I4, ISH34, CHKSURF, J1, ITY
823 LOGICAL :: FOUND
824 INTEGER :: EXT_SURFID, INT_SURFID, JI, NN1, JI1, ITY1, IVENTYP, ITYPE, NEL
825 CHARACTER (LEN = nchartitle) :: TITR1, TITR2, TITR3
826
827 itype = t_monvoln%TYPE
828 isur = t_monvoln%IBAGHOL(2, ihol)
829 iventyp = t_monvoln%IBAGHOL(13, ihol)
830 ipvent = igrsurf(isur)%ID
831 IF(iventyp == 0) THEN
832 titr1='VENT HOLE SURFACE'
833 ELSE
834 titr1='POROUS SURFACE'
835 ENDIF
836 shol = zero
837 nn = igrsurf(isur)%NSEG
838 DO j=1,nn
839 dir = half
840 i1 = igrsurf(isur)%NODES(j,1)
841 i2 = igrsurf(isur)%NODES(j,2)
842 i3 = igrsurf(isur)%NODES(j,3)
843 i4 = igrsurf(isur)%NODES(j,4)
844 ish34 = igrsurf(isur)%ELTYP(j)
845 IF(ish34==7)i4 = i3
846 IF(ish34/=3.AND.ish34/=7)
847 . CALL ancmsg(msgid=18,anmode=aninfo,msgtype=msgerror,i2=igrsurf(isur)%ID,i1=t_monvoln%ID,c1=t_monvoln%TITLE)
848 xx=half*(x(1,i1)+x(1,i2))
849 yy=half*(x(2,i1)+x(2,i2))
850 zz=half*(x(3,i1)+x(3,i2))
851 x13=x(1,i3)-x(1,i1)
852 y13=x(2,i3)-x(2,i1)
853 z13=x(3,i3)-x(3,i1)
854 x24=x(1,i4)-x(1,i2)
855 y24=x(2,i4)-x(2,i2)
856 z24=x(3,i4)-x(3,i2)
857 nx=dir*(y13*z24-y24*z13)
858 ny=dir*(z13*x24-z24*x13)
859 nz=dir*(x13*y24-x24*y13)
860 ds = sqrt(nx*nx+ny*ny+nz*nz)
861 shol = shol + ds
862 ENDDO
863C------------------------------------------------
864C Adding Svent Save Include in Surf Airbag
865C------------------------------------------------
866 chksurf=0
867 nn =igrsurf(isur)%NSEG
868 ext_surfid = t_monvoln%EXT_SURFID
869 DO j=1,nn
870 ji =igrsurf(isur)%ELEM(j)
871 ity=igrsurf(isur)%ELTYP(j)
872 IF(ity == 7) ji=ji+numelc
873 nn1 =igrsurf(ext_surfid)%NSEG
874 found = .false.
875C External surface test
876 DO j1=1,nn1
877 ji1 =igrsurf(ext_surfid)%ELEM(j1)
878 ity1=igrsurf(ext_surfid)%ELTYP(j1)
879 IF(ity1 == 7) ji1=ji1+numelc
880 IF(ji == ji1) THEN
881 found = .true.
882 EXIT
883 END IF
884 ENDDO
885 IF (.NOT. found) THEN
886 int_surfid = t_monvoln%IVOLU(67)
887 IF((itype == 8 .OR. itype == 11) .AND. int_surfid > 0 .AND. iventyp == 1) THEN
888 nn1 =igrsurf(int_surfid)%NSEG
889C Test surface interne
890 DO j1=1,nn1
891 ji1 =igrsurf(int_surfid)%ELEM(j1)
892 ity1=igrsurf(int_surfid)%ELTYP(j1)
893 IF(ity1 == 7) ji1=ji1+numelc
894 IF(ji == ji1) THEN
895 found = .true.
896 EXIT
897 END IF
898 ENDDO
899 ENDIF
900 ENDIF
901 IF(.NOT. found) chksurf = chksurf+1
902 IF (ipri >= 5.AND..NOT. found) THEN
903 IF(chksurf == 1) THEN
904 titr2 = igrsurf(isur)%TITLE
905 titr3 = igrsurf(ext_surfid)%TITLE
906 CALL ancmsg(msgid=41,anmode=aninfo,msgtype=msgerror,
907 . i1=t_monvoln%ID,
908 . c1=t_monvoln%TITLE,
909 . c2=titr1,
910 . i2=igrsurf(isur)%ID,
911 . c3=titr1,
912 . c4=titr2,
913 . i3=igrsurf(ext_surfid)%ID,
914 . c5=titr3)
915 IF((itype == 8 .OR. itype == 11) .AND. int_surfid > 0 .AND. iventyp == 1) THEN
916 titr3 = igrsurf(int_surfid)%TITLE
917 CALL ancmsg(msgid=41,anmode=aninfo,msgtype=msgerror,
918 . i1=t_monvoln%ID,
919 . c1=t_monvoln%TITLE,
920 . c2=titr1,
921 . i2=igrsurf(isur)%ID,
922 . c3=titr1,
923 . c4=titr2,
924 . i3=igrsurf(int_surfid)%ID,
925 . c5=titr3)
926 ENDIF
927 ENDIF
928 IF(ity == 3)THEN
929 nel=ixc(nixc,ji)
930 WRITE(iout,1486) nel,trim(titr1),ipvent
931 ELSEIF(ity == 7)THEN
932 nel=ixtg(nixtg,ji-numelc)
933 WRITE(iout,1487) nel,trim(titr1),ipvent
934 ENDIF
935 ENDIF
936 ENDDO
937C
938 IF (chksurf > 0) THEN
939 CALL ancmsg(msgid=903,anmode=aninfo,msgtype=msgerror,
940 . i2=igrsurf(isur)%ID,i3=igrsurf(ext_surfid)%ID,
941 . i1=t_monvoln%ID,c1=t_monvoln%TITLE,c2=titr1)
942 IF((itype == 8 .OR. itype == 11) .AND. int_surfid > 0 .AND. iventyp == 1) THEN
943 CALL ancmsg(msgid=903,anmode=aninfo,msgtype=msgerror,
944 . i2=igrsurf(isur)%ID,i3=igrsurf(int_surfid)%ID,
945 . i1=t_monvoln%ID,c1=t_monvoln%TITLE,c2=titr1)
946 ENDIF
947 END IF
948 RETURN
949 1486 FORMAT(6x,'SHELL ELEMENT ID=',i10,' OF ',a17,1x,i10,' DOES NOT BELONG TO THE AIRBAG SURFACE')
950 1487 FORMAT(6x,'SH3N ELEMENT ID=',i10,' OF ',a17,1x,i10,' DOES NOT BELONG TO THE AIRBAG SURFACE')

◆ monvol_compute_volume()

subroutine monvol_struct_mod::monvol_compute_volume ( type(monvol_struct_), intent(in) t_monvoln,
character(len = nchartitle), intent(in) title,
integer, dimension(nimv), intent(in) ivolu,
type(surf_), intent(in) surf,
integer, dimension(*), intent(in) itab,
dimension(3, *), intent(in) node_coord,
dimension(npropm, *), intent(in) pm,
dimension(npropg, *), intent(in) geo,
integer, dimension(nixc, *), intent(in) ixc,
integer, dimension(nixtg, *), intent(in) ixtg,
intent(inout) sa,
intent(inout) rot,
intent(inout) vol,
intent(inout) vmin,
intent(inout) veps,
intent(inout) sv )

Definition at line 653 of file monvol_struct_mod.F.

656C-----------------------------------------------
657C M o d u l e s
658C-----------------------------------------------
659 USE groupdef_mod
660 USE message_mod
661 USE names_and_titles_mod , ONLY : nchartitle
662 use element_mod , only : nixc,nixtg
663C-----------------------------------------------
664C I m p l i c i t T y p e s
665C-----------------------------------------------
666#include "implicit_f.inc"
667C-----------------------------------------------
668C C o m m o n B l o c k s
669C-----------------------------------------------
670C NSURF
671#include "com04_c.inc"
672C NIMV
673#include "param_c.inc"
674C nchartitle
675#include "scr17_c.inc"
676C IOUT
677#include "units_c.inc"
678C-----------------------------------------------
679C D u m m y A r g u m e n t s
680C-----------------------------------------------
681 TYPE(MONVOL_STRUCT_), INTENT(IN) :: T_MONVOLN
682 CHARACTER(LEN = nchartitle), INTENT(IN) :: TITLE
683 INTEGER, INTENT(IN) :: IVOLU(NIMV), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
684 TYPE(SURF_), INTENT(IN) :: SURF
685 my_real, INTENT(IN) :: node_coord(3, *), geo(npropg, *), pm(npropm, *)
686 my_real, INTENT(INOUT) :: sa, rot, vol, vmin, veps, sv
687C-----------------------------------------------
688C L o c a l V a r i a b l e s
689C-----------------------------------------------
690 INTEGER :: J, I
691 INTEGER :: IJET, NN, I1, I2, I3, I4, ISH34
692 my_real :: sx, sy, sz, dir
693 my_real :: xx, yy, zz, x13, y13, z13, x24, y24, z24, nx, ny, nz, ds
694C-----------------------------------------------
695C B e g i n n i n g o f s o u r c e
696C-----------------------------------------------
697 nn = surf%NSEG
698
699 ijet= 0
700 vol = zero
701 rot = zero
702 sx = zero
703 sy = zero
704 sz = zero
705 sa = zero
706
707 DO j = 1, nn
708 dir = half
709 i1 = surf%NODES(j,1)
710 i2 = surf%NODES(j,2)
711 i3 = surf%NODES(j,3)
712 i4 = surf%NODES(j,4)
713 ish34 = surf%ELTYP(j)
714 i = surf%ELEM(j)
715 IF(ish34==7)i4 = i3
716 xx =half*(node_coord(1,i1)+node_coord(1,i2))
717 yy =half*(node_coord(2,i1)+node_coord(2,i2))
718 zz =half*(node_coord(3,i1)+node_coord(3,i2))
719
720 x13=node_coord(1,i3)-node_coord(1,i1)
721 y13=node_coord(2,i3)-node_coord(2,i1)
722 z13=node_coord(3,i3)-node_coord(3,i1)
723 x24=node_coord(1,i4)-node_coord(1,i2)
724 y24=node_coord(2,i4)-node_coord(2,i2)
725 z24=node_coord(3,i4)-node_coord(3,i2)
726 nx=dir*(y13*z24-y24*z13)
727 ny=dir*(z13*x24-z24*x13)
728 nz=dir*(x13*y24-x24*y13)
729 vol = vol+third*( nx*xx+ny*yy+nz*zz )
730 sx = sx + nx
731 sy = sy + ny
732 sz = sz + nz
733 ds = sqrt(nx*nx+ny*ny+nz*nz)
734 sa = sa + ds
735 IF(ish34==3)THEN
736 rot = rot + pm(1,ixc(1,i))*geo(1,ixc(6,i))*ds
737 ELSEIF(ish34==7)THEN
738 rot = rot + pm(1,ixtg(1,i))*geo(1,ixtg(5,i))*ds
739 ENDIF
740 ENDDO
741
742 DO j = 1, t_monvoln%NB_FILL_TRI
743 dir = half
744 i1 = t_monvoln%FILL_TRI(3 * (j - 1) + 1)
745 i2 = t_monvoln%FILL_TRI(3 * (j - 1) + 2)
746 i3 = t_monvoln%FILL_TRI(3 * (j - 1) + 3)
747 i4 = i3
748
749 xx =half*(node_coord(1,i1)+node_coord(1,i2))
750 yy =half*(node_coord(2,i1)+node_coord(2,i2))
751 zz =half*(node_coord(3,i1)+node_coord(3,i2))
752
753 x13=node_coord(1,i3)-node_coord(1,i1)
754 y13=node_coord(2,i3)-node_coord(2,i1)
755 z13=node_coord(3,i3)-node_coord(3,i1)
756 x24=node_coord(1,i4)-node_coord(1,i2)
757 y24=node_coord(2,i4)-node_coord(2,i2)
758 z24=node_coord(3,i4)-node_coord(3,i2)
759 nx=dir*(y13*z24-y24*z13)
760 ny=dir*(z13*x24-z24*x13)
761 nz=dir*(x13*y24-x24*y13)
762 vol = vol+third*( nx*xx+ny*yy+nz*zz )
763 sx = sx + nx
764 sy = sy + ny
765 sz = sz + nz
766 ds = sqrt(nx*nx+ny*ny+nz*nz)
767 sa = sa + ds
768 ENDDO
769C
770 rot = rot/sa
771C
772 sv = sqrt(sx*sx+sy*sy+sz*sz)
773 vmin = em4*sa**three_half
774 veps = max(zero,vmin-abs(vol))
775C-----------------------------------------------
776C E n d o f s o u r c e
777C-----------------------------------------------
778 RETURN
max
#define max(a, b)
Definition macros.h:21
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008

◆ monvol_deallocate()

subroutine monvol_struct_mod::monvol_deallocate ( integer, intent(in) nvolu,
type(monvol_struct_), dimension(nvolu), intent(inout) t_monvol )

Definition at line 1041 of file monvol_struct_mod.F.

1042C-----------------------------------------------
1043C I m p l i c i t T y p e s
1044C-----------------------------------------------
1045#include "implicit_f.inc"
1046C-----------------------------------------------
1047C D u m m y A r g u m e n t s
1048C-----------------------------------------------
1049 INTEGER, INTENT(IN) :: NVOLU
1050 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(INOUT) :: T_MONVOL
1051C-----------------------------------------------
1052C L o c a l V a r i a b l e s
1053C-----------------------------------------------
1054 INTEGER :: II
1055
1056 DO ii = 1, nvolu
1057 IF (ALLOCATED(t_monvol(ii)%IVOLU)) DEALLOCATE(t_monvol(ii)%IVOLU)
1058 IF (ALLOCATED(t_monvol(ii)%RVOLU)) DEALLOCATE(t_monvol(ii)%RVOLU)
1059 IF (ALLOCATED(t_monvol(ii)%IBAGJET)) DEALLOCATE(t_monvol(ii)%IBAGJET)
1060 IF (ALLOCATED(t_monvol(ii)%RBAGJET)) DEALLOCATE(t_monvol(ii)%RBAGJET)
1061 IF (ALLOCATED(t_monvol(ii)%IBAGHOL)) DEALLOCATE(t_monvol(ii)%IBAGHOL)
1062 IF (ALLOCATED(t_monvol(ii)%RBAGHOL)) DEALLOCATE(t_monvol(ii)%RBAGHOL)
1063 IF (ALLOCATED(t_monvol(ii)%NODES)) DEALLOCATE(t_monvol(ii)%NODES)
1064 IF (ALLOCATED(t_monvol(ii)%ELEM)) DEALLOCATE(t_monvol(ii)%ELEM)
1065 IF (ALLOCATED(t_monvol(ii)%ITAGEL)) DEALLOCATE(t_monvol(ii)%ITAGEL)
1066 IF (ALLOCATED(t_monvol(ii)%ELTG)) DEALLOCATE(t_monvol(ii)%ELTG)
1067 IF (ALLOCATED(t_monvol(ii)%MATTG)) DEALLOCATE(t_monvol(ii)%MATTG)
1068 IF (ALLOCATED(t_monvol(ii)%TBRIC)) DEALLOCATE(t_monvol(ii)%TBRIC)
1069 IF (ALLOCATED(t_monvol(ii)%TFAC)) DEALLOCATE(t_monvol(ii)%TFAC)
1070 IF (ALLOCATED(t_monvol(ii)%TAGELS)) DEALLOCATE(t_monvol(ii)%TAGELS)
1071 IF (ALLOCATED(t_monvol(ii)%IBUFA)) DEALLOCATE(t_monvol(ii)%IBUFA)
1072 IF (ALLOCATED(t_monvol(ii)%ELEMA)) DEALLOCATE(t_monvol(ii)%ELEMA)
1073 IF (ALLOCATED(t_monvol(ii)%BRNA)) DEALLOCATE(t_monvol(ii)%BRNA)
1074 IF (ALLOCATED(t_monvol(ii)%TAGELA)) DEALLOCATE(t_monvol(ii)%TAGELA)
1075 IF (ALLOCATED(t_monvol(ii)%NCONA)) DEALLOCATE(t_monvol(ii)%NCONA)
1076 IF (ALLOCATED(t_monvol(ii)%VELOCITY)) DEALLOCATE(t_monvol(ii)%VELOCITY)
1077 IF (ALLOCATED(t_monvol(ii)%NODE_COORD)) DEALLOCATE(t_monvol(ii)%NODE_COORD)
1078 IF (ALLOCATED(t_monvol(ii)%POROSITY)) DEALLOCATE(t_monvol(ii)%POROSITY)
1079 IF (ALLOCATED(t_monvol(ii)%THSURF_TAG)) DEALLOCATE(t_monvol(ii)%THSURF_TAG)
1080 IF (ALLOCATED(t_monvol(ii)%ELAREA)) DEALLOCATE(t_monvol(ii)%ELAREA)
1081 IF (ALLOCATED(t_monvol(ii)%FILL_TRI)) DEALLOCATE(t_monvol(ii)%FILL_TRI)
1082 IF (ALLOCATED(t_monvol(ii)%EDGE_NODE1)) DEALLOCATE(t_monvol(ii)%EDGE_NODE1)
1083 IF (ALLOCATED(t_monvol(ii)%EDGE_NODE2)) DEALLOCATE(t_monvol(ii)%EDGE_NODE2)
1084 IF (ALLOCATED(t_monvol(ii)%EDGE_ELEM)) DEALLOCATE(t_monvol(ii)%EDGE_ELEM)
1085 IF (ALLOCATED(t_monvol(ii)%IAD_EDGE_ELEM)) DEALLOCATE(t_monvol(ii)%IAD_EDGE_ELEM)
1086 ENDDO