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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ nodalvfrac()

subroutine nodalvfrac ( 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 35 of file nodalvfrac.F.

37C-----------------------------------------------
38C D e s c r i p t i o n
39C-----------------------------------------------
40C This suroutine computes nodal volumetric fraction for
41C ALE elements. In case of CEL coupling (inter22)
42C result is also calculated from cut cells.
43C Aim is to expand centroid values to nodal positions
44C-----------------------------------------------
45C P r e - C o n d i t i o n s
46C-----------------------------------------------
47C Tested below during NG LOOP : IALEL > 0
48C where IALEL =IPARG(7,NG)+IPARG(11,NG)
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE initbuf_mod
53 USE elbufdef_mod
55 USE i22edge_mod
56 USE i22tri_mod
57 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "vect01_c.inc"
68#include "param_c.inc"
69#include "inter22.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER,INTENT(IN) :: IFUNC, IFLOW(*),IPARG(NPARG,*),IX(NIX,*),ITAB(*),NIX,NV46
74 my_real,INTENT(IN) :: rflow(*)
75 REAL,INTENT(INOUT) :: WA4(*)
76
77 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
78 TYPE(BUF_MAT_),POINTER :: MBUF
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER :: IADI, IADR, I, ITYP, NINOUT, NNO, NEL, II1, II2,K1,K,
83 . IR1, IR2, J, JJ, NNO_L, NNI_L, II3, II4, JJJ, NNI,
84 . IALEL,NNOD,IPOS,IV,NGv,J1,J2,IBV, MLW,NumNodCell,
85 . NG, KCVT, II, NBF, NBL, IB, ICELL, NIN, MCELL,
86 . IPHASE
87 TYPE(G_BUFEL_) ,POINTER :: GBUF,GBUFv
88 my_real, ALLOCATABLE, DIMENSION(:) :: count_vol
89 my_real :: p,vf,d,v
90 INTEGER,DIMENSION(:,:), POINTER :: pAdjBRICK
91C-----------------------------------------------
92C D e s c r i p t i o n
93C-----------------------------------------------
94C This subroutine writes nodal VFRAC
95C /INTER/TYPE22 (only).
96C
97C-----------------------------------------------
98C S o u r c e L i n e s
99C-----------------------------------------------
100
101
102 nnod = nix-3 !8-node brick or 4-node quad
103 iphase = ifunc-19
104
105 IF(int22==0)THEN
106 !---------------------------------------------------------!
107 ! ALE STANDARD FORMULATION !
108 !---------------------------------------------------------!
109 !1. COMPUTE NODAL VALUE !
110 !---------------------------------------------------------!
111 !---1. COMPUTE NODAL VFRAC---!
112 ALLOCATE(count_vol(numnod))
113 count_vol(:) = 0
114 DO ng = 1, ngroup
115 mlw = iparg(1,ng)
116 nel = iparg(2,ng)
117 nft = iparg(3,ng)
118 ityp = iparg(5,ng)
119 ialel = iparg(7,ng)+iparg(11,ng)
120 IF(ityp/=1 .AND. ityp/=2)cycle
121 IF(ialel==0)cycle
122 IF(mlw/=37.AND.mlw/=51)cycle
123 gbuf => elbuf_tab(ng)%GBUF
124 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
125 IF(mlw==37)THEN
126 DO i=1,nel
127 vf = mbuf%VAR(nel*(3+iphase-1)+i) !liquid or gas in uvar(I,4:5)
128 v = gbuf%VOL(i)
129 DO j=2,nnod+1
130 jj = ix(j,nft+i)
131 wa4(jj) = wa4(jj)+vf*v*one_over_8
132 count_vol(jj) = count_vol(jj) + v * one_over_8
133 ENDDO !next J
134 enddo! next I
135 ELSEIF(mlw==51)THEN
136 DO i=1,nel
137 ipos = 1
138 k1 = m51_n0phas + (iphase-1)*m51_nvphas +ipos-1 ! example : IPOS=1 => VFRAC {UVAR(I,ADD)=UVAR(K+I)}
139 k = k1 * nel
140 vf = mbuf%VAR(k+i)
141 v = gbuf%VOL(i)
142 DO j=2,nnod+1
143 jj = ix(j,nft+i)
144 wa4(jj) = wa4(jj)+vf*v*one_over_8
145 count_vol(jj) = count_vol(jj) + v * one_over_8
146 ENDDO !next J
147 enddo! next I
148 ENDIF
149 enddo!next NG
150 !applying weight factor
151 DO i=1,numnod
152 IF(count_vol(i)/=zero)THEN
153 wa4(i)=wa4(i)/count_vol(i)
154 ENDIF
155 ENDDO
156 DEALLOCATE(count_vol)
157 ELSEIF(int22>0)THEN
158 !---------------------------------------------------------!
159 ! /INTER/TYPE22 !
160 !---------------------------------------------------------!
161 !1. TAG FOR CUT CELL !
162 !2. COMPUTE NODAL VALUE !
163 ! NOT INTERSECTED : NODAL Val COMPUTED FROM GLOBAL BUF !
164 !---------------------------------------------------------!
165 !---1. TAG FOR INTERSECTED BRICKS---!
166 !NBF = 1+ITASK*NB/NTHREAD
167 !NBL = (ITASK+1)*NB/NTHREAD
168 nbf = 1
169 nbl = nb
170 nin = 1
171 !---1. COMPUTE NODAL PRESSURE---!
172 ALLOCATE(count_vol(numnod))
173 count_vol = 0
174 DO ng = 1, ngroup
175 mlw = iparg(1,ng)
176 nel = iparg(2,ng)
177 nft = iparg(3,ng)
178 ityp = iparg(5,ng)
179 ialel = iparg(7,ng)+iparg(11,ng)
180 IF(ityp/=1 .AND. ityp/=2)cycle
181 IF(ialel==0)cycle
182 IF(mlw/=37.AND.mlw/=51)cycle
183 gbuf => elbuf_tab(ng)%GBUF
184 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
185 DO i=1,nel
186 ib = nint(gbuf%TAG22(i))
187 !---------------------------!
188 ! NOT A CUT CELL !
189 !---------------------------!
190 IF(ib==0)THEN
191 IF(mlw==37)THEN
192 vf = mbuf%VAR(nel*(3+iphase-1)+i) !liquid or gas in uvar(I,4:5)
193 v = gbuf%VOL(i)
194 DO j=2,nnod+1
195 jj = ix(j,nft+i)
196 wa4(jj) = wa4(jj)+vf*v*one_over_8
197 count_vol(jj) = count_vol(jj) + v * one_over_8 !cumulated volume
198 ENDDO !next J
199 ELSEIF(mlw==51)THEN
200 ipos = 1
201 k1 = m51_n0phas + (iphase-1)*m51_nvphas +ipos-1 ! example : IPOS=1 => VFRAC {UVAR(I,ADD)=UVAR(K+I)}
202 k = k1 * nel
203 vf = mbuf%VAR(k+i)
204 v = gbuf%VOL(i)
205 DO j=2,nnod+1
206 jj = ix(j,nft+i)
207 wa4(jj) = wa4(jj)+vf*v*one_over_8
208 count_vol(jj) = count_vol(jj) + v * one_over_8
209 ENDDO !next J
210 ENDIF
211 !---------------------------!
212 ! CUT CELL !
213 !---------------------------!
214 ELSE
215 nin = 1
216 DO j=2,nnod+1
217 jj = ix(j,nft+i)
218 icell = brick_list(nin,ib)%NODE(j-1)%WhichCell
219 vf = brick_list(nin,ib)%POLY(icell)%VFRACm(iphase)
220 ! if(vf<zero .or. vf>un)then
221 ! print *,"**inter22, cell vfrac warning", vf
222 ! endif
223 numnodcell = brick_list(nin,ib)%POLY(icell)%NumNOD
224 v = brick_list(nin,ib)%POLY(icell)%Vnew
225 wa4(jj) = wa4(jj)+vf*v/numnodcell
226 count_vol(jj) = count_vol(jj) + v / numnodcell
227 ENDDO !next J
228 ENDIF
229 enddo!next I
230 enddo!next NG
231 DO i=1,numnod
232 IF(count_vol(i)/=zero)THEN
233 wa4(i)=wa4(i)/count_vol(i)
234 ENDIF
235 ENDDO
236 DEALLOCATE(count_vol)
237
238 endif!INT22
239
240
241C-----------------------------------------------
242 RETURN
#define my_real
Definition cppsort.cpp:32
type(brick_entity), dimension(:,:), allocatable, target brick_list