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

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

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

796 USE groupdef_mod
797 USE message_mod
798C-----------------------------------------------
799C I m p l i c i t T y p e s
800C-----------------------------------------------
801#include "implicit_f.inc"
802#include "units_c.inc"
803#include "param_c.inc"
804#include "com04_c.inc"
805C-----------------------------------------------
806C D u m m y A r g u m e n t s
807C-----------------------------------------------
808 TYPE(MONVOL_STRUCT_), INTENT(IN) :: T_MONVOLN
809 INTEGER, INTENT(IN) :: IHOL, IPRI
810 INTEGER, INTENT(IN) :: IXC(NIXC, *), IXTG(NIXTG, *)
811 my_real, INTENT(IN) :: x(3, *)
812 my_real, INTENT(OUT) :: shol
813 TYPE (SURF_), DIMENSION(NSURF), INTENT(IN) :: IGRSURF
814C-----------------------------------------------
815C L o c a l V a r i a b l e s
816C-----------------------------------------------
817 INTEGER :: ISUR, IPVENT, NN, J
818 my_real :: dir, xx, yy, zz, x13, y13, z13, x24, y24, z24,
819 . nx, ny, nz, ds
820 INTEGER :: I1, I2, I3, I4, ISH34, CHKSURF, J1, ITY
821 LOGICAL :: FOUND
822 INTEGER :: EXT_SURFID, INT_SURFID, JI, NN1, JI1, ITY1, IVENTYP, ITYPE, NEL
823 CHARACTER (LEN = nchartitle) :: TITR1, TITR2, TITR3
824
825 itype = t_monvoln%TYPE
826 isur = t_monvoln%IBAGHOL(2, ihol)
827 iventyp = t_monvoln%IBAGHOL(13, ihol)
828 ipvent = igrsurf(isur)%ID
829 IF(iventyp == 0) THEN
830 titr1='VENT HOLE SURFACE'
831 ELSE
832 titr1='POROUS SURFACE'
833 ENDIF
834 shol = zero
835 nn = igrsurf(isur)%NSEG
836 DO j=1,nn
837 dir = half
838 i1 = igrsurf(isur)%NODES(j,1)
839 i2 = igrsurf(isur)%NODES(j,2)
840 i3 = igrsurf(isur)%NODES(j,3)
841 i4 = igrsurf(isur)%NODES(j,4)
842 ish34 = igrsurf(isur)%ELTYP(j)
843 IF(ish34==7)i4 = i3
844 IF(ish34/=3.AND.ish34/=7)
845 . CALL ancmsg(msgid=18,anmode=aninfo,msgtype=msgerror,i2=igrsurf(isur)%ID,i1=t_monvoln%ID,c1=t_monvoln%TITLE)
846 xx=half*(x(1,i1)+x(1,i2))
847 yy=half*(x(2,i1)+x(2,i2))
848 zz=half*(x(3,i1)+x(3,i2))
849 x13=x(1,i3)-x(1,i1)
850 y13=x(2,i3)-x(2,i1)
851 z13=x(3,i3)-x(3,i1)
852 x24=x(1,i4)-x(1,i2)
853 y24=x(2,i4)-x(2,i2)
854 z24=x(3,i4)-x(3,i2)
855 nx=dir*(y13*z24-y24*z13)
856 ny=dir*(z13*x24-z24*x13)
857 nz=dir*(x13*y24-x24*y13)
858 ds = sqrt(nx*nx+ny*ny+nz*nz)
859 shol = shol + ds
860 ENDDO
861C------------------------------------------------
862C Ajout condition Svent incluse dans Surf airbag
863C------------------------------------------------
864 chksurf=0
865 nn =igrsurf(isur)%NSEG
866 ext_surfid = t_monvoln%EXT_SURFID
867 DO j=1,nn
868 ji =igrsurf(isur)%ELEM(j)
869 ity=igrsurf(isur)%ELTYP(j)
870 IF(ity == 7) ji=ji+numelc
871 nn1 =igrsurf(ext_surfid)%NSEG
872 found = .false.
873C Test surface externe
874 DO j1=1,nn1
875 ji1 =igrsurf(ext_surfid)%ELEM(j1)
876 ity1=igrsurf(ext_surfid)%ELTYP(j1)
877 IF(ity1 == 7) ji1=ji1+numelc
878 IF(ji == ji1) THEN
879 found = .true.
880 EXIT
881 END IF
882 ENDDO
883 IF (.NOT. found) THEN
884 int_surfid = t_monvoln%IVOLU(67)
885 IF((itype == 8 .OR. itype == 11) .AND. int_surfid > 0 .AND. iventyp == 1) THEN
886 nn1 =igrsurf(int_surfid)%NSEG
887C Test surface interne
888 DO j1=1,nn1
889 ji1 =igrsurf(int_surfid)%ELEM(j1)
890 ity1=igrsurf(int_surfid)%ELTYP(j1)
891 IF(ity1 == 7) ji1=ji1+numelc
892 IF(ji == ji1) THEN
893 found = .true.
894 EXIT
895 END IF
896 ENDDO
897 ENDIF
898 ENDIF
899 IF(.NOT. found) chksurf = chksurf+1
900 IF (ipri >= 5.AND..NOT. found) THEN
901 IF(chksurf == 1) THEN
902 titr2 = igrsurf(isur)%TITLE
903 titr3 = igrsurf(ext_surfid)%TITLE
904 CALL ancmsg(msgid=41,anmode=aninfo,msgtype=msgerror,
905 . i1=t_monvoln%ID,
906 . c1=t_monvoln%TITLE,
907 . c2=titr1,
908 . i2=igrsurf(isur)%ID,
909 . c3=titr1,
910 . c4=titr2,
911 . i3=igrsurf(ext_surfid)%ID,
912 . c5=titr3)
913 IF((itype == 8 .OR. itype == 11) .AND. int_surfid > 0 .AND. iventyp == 1) THEN
914 titr3 = igrsurf(int_surfid)%TITLE
915 CALL ancmsg(msgid=41,anmode=aninfo,msgtype=msgerror,
916 . i1=t_monvoln%ID,
917 . c1=t_monvoln%TITLE,
918 . c2=titr1,
919 . i2=igrsurf(isur)%ID,
920 . c3=titr1,
921 . c4=titr2,
922 . i3=igrsurf(int_surfid)%ID,
923 . c5=titr3)
924 ENDIF
925 ENDIF
926 IF(ity == 3)THEN
927 nel=ixc(nixc,ji)
928 WRITE(iout,1486) nel,trim(titr1),ipvent
929 ELSEIF(ity == 7)THEN
930 nel=ixtg(nixtg,ji-numelc)
931 WRITE(iout,1487) nel,trim(titr1),ipvent
932 ENDIF
933 ENDIF
934 ENDDO
935C
936 IF (chksurf > 0) THEN
937 CALL ancmsg(msgid=903,anmode=aninfo,msgtype=msgerror,
938 . i2=igrsurf(isur)%ID,i3=igrsurf(ext_surfid)%ID,
939 . i1=t_monvoln%ID,c1=t_monvoln%TITLE,c2=titr1)
940 IF((itype == 8 .OR. itype == 11) .AND. int_surfid > 0 .AND. iventyp == 1) THEN
941 CALL ancmsg(msgid=903,anmode=aninfo,msgtype=msgerror,
942 . i2=igrsurf(isur)%ID,i3=igrsurf(int_surfid)%ID,
943 . i1=t_monvoln%ID,c1=t_monvoln%TITLE,c2=titr1)
944 ENDIF
945 END IF
946 RETURN
947 1486 FORMAT(6x,'SHELL ELEMENT ID=',i10,' OF ',a17,1x,i10,' DOES NOT BELONG TO THE AIRBAG SURFACE')
948 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
662C-----------------------------------------------
663C I m p l i c i t T y p e s
664C-----------------------------------------------
665#include "implicit_f.inc"
666C-----------------------------------------------
667C C o m m o n B l o c k s
668C-----------------------------------------------
669C NSURF
670#include "com04_c.inc"
671C NIMV
672#include "param_c.inc"
673C nchartitle
674#include "scr17_c.inc"
675C IOUT
676#include "units_c.inc"
677C-----------------------------------------------
678C D u m m y A r g u m e n t s
679C-----------------------------------------------
680 TYPE(MONVOL_STRUCT_), INTENT(IN) :: T_MONVOLN
681 CHARACTER(LEN = nchartitle), INTENT(IN) :: TITLE
682 INTEGER, INTENT(IN) :: IVOLU(NIMV), ITAB(*), IXC(NIXC, *), IXTG(NIXTG, *)
683 TYPE(SURF_), INTENT(IN) :: SURF
684 my_real, INTENT(IN) :: node_coord(3, *), geo(npropg, *), pm(npropm, *)
685 my_real, INTENT(INOUT) :: sa, rot, vol, vmin, veps, sv
686C-----------------------------------------------
687C L o c a l V a r i a b l e s
688C-----------------------------------------------
689 INTEGER :: J, I
690 INTEGER :: IJET, NN, I1, I2, I3, I4, ISH34
691 my_real :: sx, sy, sz, dir
692 my_real :: xx, yy, zz, x13, y13, z13, x24, y24, z24, nx, ny, nz, ds
693C-----------------------------------------------
694C B e g i n n i n g o f s o u r c e
695C-----------------------------------------------
696 nn = surf%NSEG
697
698 ijet= 0
699 vol = zero
700 rot = zero
701 sx = zero
702 sy = zero
703 sz = zero
704 sa = zero
705
706 DO j = 1, nn
707 dir = half
708 i1 = surf%NODES(j,1)
709 i2 = surf%NODES(j,2)
710 i3 = surf%NODES(j,3)
711 i4 = surf%NODES(j,4)
712 ish34 = surf%ELTYP(j)
713 i = surf%ELEM(j)
714 IF(ish34==7)i4 = i3
715 xx =half*(node_coord(1,i1)+node_coord(1,i2))
716 yy =half*(node_coord(2,i1)+node_coord(2,i2))
717 zz =half*(node_coord(3,i1)+node_coord(3,i2))
718
719 x13=node_coord(1,i3)-node_coord(1,i1)
720 y13=node_coord(2,i3)-node_coord(2,i1)
721 z13=node_coord(3,i3)-node_coord(3,i1)
722 x24=node_coord(1,i4)-node_coord(1,i2)
723 y24=node_coord(2,i4)-node_coord(2,i2)
724 z24=node_coord(3,i4)-node_coord(3,i2)
725 nx=dir*(y13*z24-y24*z13)
726 ny=dir*(z13*x24-z24*x13)
727 nz=dir*(x13*y24-x24*y13)
728 vol = vol+third*( nx*xx+ny*yy+nz*zz )
729 sx = sx + nx
730 sy = sy + ny
731 sz = sz + nz
732 ds = sqrt(nx*nx+ny*ny+nz*nz)
733 sa = sa + ds
734 IF(ish34==3)THEN
735 rot = rot + pm(1,ixc(1,i))*geo(1,ixc(6,i))*ds
736 ELSEIF(ish34==7)THEN
737 rot = rot + pm(1,ixtg(1,i))*geo(1,ixtg(5,i))*ds
738 ENDIF
739 ENDDO
740
741 DO j = 1, t_monvoln%NB_FILL_TRI
742 dir = half
743 i1 = t_monvoln%FILL_TRI(3 * (j - 1) + 1)
744 i2 = t_monvoln%FILL_TRI(3 * (j - 1) + 2)
745 i3 = t_monvoln%FILL_TRI(3 * (j - 1) + 3)
746 i4 = i3
747
748 xx =half*(node_coord(1,i1)+node_coord(1,i2))
749 yy =half*(node_coord(2,i1)+node_coord(2,i2))
750 zz =half*(node_coord(3,i1)+node_coord(3,i2))
751
752 x13=node_coord(1,i3)-node_coord(1,i1)
753 y13=node_coord(2,i3)-node_coord(2,i1)
754 z13=node_coord(3,i3)-node_coord(3,i1)
755 x24=node_coord(1,i4)-node_coord(1,i2)
756 y24=node_coord(2,i4)-node_coord(2,i2)
757 z24=node_coord(3,i4)-node_coord(3,i2)
758 nx=dir*(y13*z24-y24*z13)
759 ny=dir*(z13*x24-z24*x13)
760 nz=dir*(x13*y24-x24*y13)
761 vol = vol+third*( nx*xx+ny*yy+nz*zz )
762 sx = sx + nx
763 sy = sy + ny
764 sz = sz + nz
765 ds = sqrt(nx*nx+ny*ny+nz*nz)
766 sa = sa + ds
767 ENDDO
768C
769 rot = rot/sa
770C
771 sv = sqrt(sx*sx+sy*sy+sz*sz)
772 vmin = em4*sa**three_half
773 veps = max(zero,vmin-abs(vol))
774C-----------------------------------------------
775C E n d o f s o u r c e
776C-----------------------------------------------
777 RETURN
max
#define max(a, b)
Definition macros.h:21
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003

◆ monvol_deallocate()

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

Definition at line 1039 of file monvol_struct_mod.F.

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