OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
nodalzvol.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "inter22.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine nodalzvol (ifunc, wa4, iflow, rflow, iparg, elbuf_tab, ix, nix, itab, nv46)

Function/Subroutine Documentation

◆ nodalzvol()

subroutine nodalzvol ( integer, intent(in) ifunc,
real, dimension(*), intent(inout) wa4,
integer, dimension(*), intent(in) iflow,
dimension(*), intent(in) rflow,
integer, dimension(nparg,*), intent(in) iparg,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nix,*), intent(in) ix,
integer, intent(in) nix,
integer, dimension(*), intent(in) itab,
integer, intent(in) nv46 )

Definition at line 34 of file nodalzvol.F.

36C-----------------------------------------------
37C D e s c r i p t i o n
38C-----------------------------------------------
39C This suroutine display polyhedra volume (old & new)
40C using free node as marker (inter22 only, see input card for grnod_id)
41C-----------------------------------------------
42C P r e - C o n d i t i o n s
43C-----------------------------------------------
44C Tested below during NG LOOP : IALEL > 0
45C where IALEL =IPARG(7,NG)+IPARG(11,NG)
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE initbuf_mod
50 USE elbufdef_mod
52 USE i22edge_mod
53 USE i22tri_mod
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "com01_c.inc"
62#include "vect01_c.inc"
63#include "param_c.inc"
64#include "inter22.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 INTEGER,INTENT(IN) :: IFUNC, IFLOW(*),IPARG(NPARG,*),IX(NIX,*),ITAB(*),NIX,NV46
69 my_real,INTENT(IN) :: rflow(*)
70 REAL,INTENT(INOUT) :: WA4(*)
71
72 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER :: IADI, IADR, I, ITYP, NINOUT, NNO, NEL, II1, II2,K1,K,
77 . IR1, IR2, J, JJ, NNO_L, NNI_L, II3, II4, JJJ, NNI,
78 . IALEL,NNOD,IPOS,IV,NGv,J1,J2,IBV, MLW,NumNodCell,
79 . NG, KCVT, II, NBF, NBL, IB, ICELL, NIN, MCELL,NCELL,
80 . IPHASE,NODE_ID,INEW
81 TYPE(G_BUFEL_) ,POINTER :: GBUF,GBUFv
82 my_real, ALLOCATABLE, DIMENSION(:) :: count_vol
83 my_real :: p,vf,d,v
84 INTEGER,DIMENSION(:,:), POINTER :: pAdjBRICK
85C-----------------------------------------------
86C D e s c r i p t i o n
87C-----------------------------------------------
88C This subroutine writes nodal VFRAC
89C /INTER/TYPE22 (only).
90C-----------------------------------------------
91C P r e c o n d i t i o n s
92C-----------------------------------------------
93 IF(int22==0)RETURN
94C-----------------------------------------------
95C S o u r c e L i n e s
96C-----------------------------------------------
97
98 nnod = nix-3 !8-node brick or 4-node quad
99 inew = 29-ifunc ! 1: new cell volume, 0:old
100
101 !---------------------------------------------------------!
102 ! /INTER/TYPE22 !
103 !---------------------------------------------------------!
104 ! CELL CENTROIDS ARE MARKED IN CUT CELL BUFFER !
105 ! PURPOSE IS TO DISPLAY CELL SCALR USING FREE NODE !
106 !---------------------------------------------------------!
107 !---1. TAG FOR INTERSECTED BRICKS---!
108 nbf = 1
109 nbl = nb
110 nin = 1
111 !---1. COMPUTE NODAL PRESSURE---!
112 DO ng = 1, ngroup
113 mlw = iparg(1,ng)
114 nel = iparg(2,ng)
115 nft = iparg(3,ng)
116 ityp = iparg(5,ng)
117 ialel = iparg(7,ng)+iparg(11,ng)
118 IF(ityp/=1 .AND. ityp/=2)cycle
119 IF(ialel==0)cycle
120 IF(mlw/=6 .AND. mlw/=11 .AND. mlw/=37.AND.mlw/=51)cycle
121 gbuf => elbuf_tab(ng)%GBUF
122 nin = 1
123 DO i=1,nel
124 ib = nint(gbuf%TAG22(i))
125 !---------------------------!
126 ! NOT A CUT CELL !
127 !---------------------------!
128 IF(ib==0)cycle
129 !---------------------------!
130 ! CUT CELL !
131 !---------------------------!
132 icell = 0
133 ncell = brick_list(nin,ib)%NBCUT
134 DO WHILE (icell<=ncell) ! loop on polyhedron {1:NCELL} U {9}
135 icell = icell +1
136 IF (icell>ncell .AND. ncell/=0)icell=9
137 node_id = brick_list(nin,ib)%POLY(icell)%ID_FREE_NODE
138 IF(node_id<=0)EXIT ! no enough nodes in the group or debug option not compatible with smp
139 IF(inew == 1)THEN
140 wa4(node_id) = brick_list(nin,ib)%POLY(icell)%VNEW
141 ELSE
142 wa4(node_id) = brick_list(nin,ib)%POLY(icell)%VOLD
143 ENDIF
144 ENDDO
145 enddo!next i
146 enddo!next NG
147
148
149C-----------------------------------------------
150 RETURN
#define my_real
Definition cppsort.cpp:32
type(brick_entity), dimension(:,:), allocatable, target brick_list