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

Go to the source code of this file.

Functions/Subroutines

subroutine inimom_fvm (v, rho, vol, mom, ixs, ipm, mat, iparg1, npf, tf, pm, ssp, sig, nel)

Function/Subroutine Documentation

◆ inimom_fvm()

subroutine inimom_fvm ( v,
rho,
vol,
mom,
integer, dimension(nixs,*) ixs,
integer, dimension(npropmi,*) ipm,
integer, dimension(mvsiz) mat,
integer, dimension(nparg) iparg1,
integer, dimension(*) npf,
tf,
pm,
ssp,
sig,
integer nel )

Definition at line 31 of file inimom_fvm.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE alefvm_mod
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "vect01_c.inc"
52#include "param_c.inc"
53#include "inter22.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER :: NEL
58 my_real :: v(3,*) , rho(*) , vol(*) , mom(nel,3) , tf(*) , pm(npropm,*) , ssp(*), sig(nel,6)
59 INTEGER :: IXS(NIXS,*), IPM(NPROPMI,*), MAT(MVSIZ), IPARG1(NPARG), NPF(*)
60C-----------------------------------------------
61C D e s c r i p t i o n
62C-----------------------------------------------
63C
64C +------------+------------+ -----> v2(1:3) => q2(1:3) = RHO*V/4 * v2(1:3)
65C | | |
66C | | V/4 |
67C | q1 | RHO |
68C | | q2(1:3) |
69C | | |
70C +------------+------------+ q_elem(1:3) = sum( qi ,i=1..4)
71C | | | ______________________________
72C | | |
73C | q4 | q3 |
74C | | |
75C | | |
76C +------------+------------+
77C
78C ACONVE()
79C Warning : rho * vel [in] ---------> rho*V * vel [out]
80C Here rho*vel are stored.
81C
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER :: I, J, II, IALEFVM_FLG,IALEL,IVxFUN, IVyFUN, IVzFUN, MX, MLW, ITYP
86 my_real :: subvol, vcell(3), vnod(3,8),
87 . vx1(mvsiz), vx2(mvsiz), vx3(mvsiz), vx4(mvsiz), vx5(mvsiz), vx6(mvsiz), vx7(mvsiz), vx8(mvsiz),
88 . vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz), vy5(mvsiz), vy6(mvsiz), vy7(mvsiz), vy8(mvsiz),
89 . vz1(mvsiz), vz2(mvsiz), vz3(mvsiz), vz4(mvsiz), vz5(mvsiz), vz6(mvsiz), vz7(mvsiz), vz8(mvsiz),
90 . vx0 , vy0 , vz0,
91 . vx , vy , vz ,
92 . dydx , t0
93 my_real,EXTERNAL :: finter
94C-----------------------------------------------
95C P r e - C o n d i t i o n s
96C-----------------------------------------------
97C Check activation flag for FVM momentum
98
99 ialel = iparg1(7)+iparg1(11)
100 IF(ialel == 0)RETURN
101 IF(alefvm_param%IEnabled==0)RETURN !global unplug if option not present in input file
102
103C-----------------------------------------------
104C S o u r c e L i n e s
105C-----------------------------------------------
106
107 !-----------------------------------------
108 ! IF DEFINED /ALE/SOLVER/
109 !-----------------------------------------
110 !automatic FVM SOLVER for ALE
111 IF(int22>0)THEN
112 IF(alefvm_param%ISOLVER<=1) THEN
113 alefvm_param%ISOLVER=5
114 IF(alefvm_param%IPRINT_1==0)THEN
115 !print *, "** WARNING INT22 : UNDEFINED /ALE/SOLVER CARD"
116 !print *, " ENABLING IT AUTOMATICALLY WITH IMOM_VEL=5"
117 alefvm_param%IPRINT_1 = 1
118 ENDIF
119 ELSEIF(alefvm_param%ISOLVER/=5)THEN
120 alefvm_param%ISOLVER=5
121 IF(alefvm_param%IPRINT_2==0)THEN
122 print *, "** WARNING INT22 : /ALE/SOLVER CARD"
123 print *, " RECOMMENDED VALUE IS IMOM_VEL=5"
124 alefvm_param%IPRINT_2 = 1
125 ENDIF
126 ENDIF
127 ENDIF
128
129 IF(alefvm_param%ISOLVER>0)THEN
130 ipm(251,mat(1)) = alefvm_param%ISOLVER
131 ! 0: Default = 1 expect if /ALE/MAT or /EULER/MAT has IFROM flag defined.
132 ! 1 : FEM
133 ! 2 : FVM U average
134 ! 3 : FVM rho.U average
135 ! 4 : FVM rho.c.U average
136 ! 5 : Godunov Acoustic
137 ! 6 : experimental
138 ENDIF
139
140
141 mlw = iparg1(1)
142 !-----------------------------------------
143
144 !-----------------------------------------
145 IF(mlw /= 11) THEN
146
147 DO i=lft,llt
148 ii = i+nft
149 !---nod-1
150 vx1(i) = v(1,ixs(2,ii))
151 vy1(i) = v(2,ixs(2,ii))
152 vz1(i) = v(3,ixs(2,ii))
153 !---nod-2
154 vx2(i) = v(1,ixs(3,ii))
155 vy2(i) = v(2,ixs(3,ii))
156 vz2(i) = v(3,ixs(3,ii))
157 !---nod-3
158 vx3(i) = v(1,ixs(4,ii))
159 vy3(i) = v(2,ixs(4,ii))
160 vz3(i) = v(3,ixs(4,ii))
161 !---nod-4
162 vx4(i) = v(1,ixs(5,ii))
163 vy4(i) = v(2,ixs(5,ii))
164 vz4(i) = v(3,ixs(5,ii))
165 !---nod-5
166 vx5(i) = v(1,ixs(6,ii))
167 vy5(i) = v(2,ixs(6,ii))
168 vz5(i) = v(3,ixs(6,ii))
169 !---nod-6
170 vx6(i) = v(1,ixs(7,ii))
171 vy6(i) = v(2,ixs(7,ii))
172 vz6(i) = v(3,ixs(7,ii))
173 !---nod-7
174 vx7(i) = v(1,ixs(8,ii))
175 vy7(i) = v(2,ixs(8,ii))
176 vz7(i) = v(3,ixs(8,ii))
177 !---nod-8
178 vx8(i) = v(1,ixs(9,ii))
179 vy8(i) = v(2,ixs(9,ii))
180 vz8(i) = v(3,ixs(9,ii))
181 !---cell_velocity---!
182 vcell(1) = one_over_8 * (vx1(i)+vx2(i)+vx3(i)+vx4(i)+vx5(i)+vx6(i)+vx7(i)+vx8(i))
183 vcell(2) = one_over_8 * (vy1(i)+vy2(i)+vy3(i)+vy4(i)+vy5(i)+vy6(i)+vy7(i)+vy8(i))
184 vcell(3) = one_over_8 * (vz1(i)+vz2(i)+vz3(i)+vz4(i)+vz5(i)+vz6(i)+vz7(i)+vz8(i))
185 !---momentum---!
186 !MOM(I,1:3) = RHO(I) * Vcell(1:3)
187 !rho*VOL* VEL in aconve. VEL is needed before for FLUXES
188 mom(i,1) = vcell(1)*rho(i)
189 mom(i,2) = vcell(2)*rho(i)
190 mom(i,3) = vcell(3)*rho(i)
191 ENDDO
192
193 !write(*,*) "MOMENTUM from inimom_fvm.F"
194 DO i=lft,llt
195 ii = i+nft
196 alefvm_buffer%FCELL(1,ii) = mom(i,1)
197 alefvm_buffer%FCELL(2,ii) = mom(i,2)
198 alefvm_buffer%FCELL(3,ii) = mom(i,3)
199 alefvm_buffer%FCELL(4,ii) = rho(i)
200 alefvm_buffer%FCELL(5,ii) = ssp(i)
201 alefvm_buffer%FCELL(6,ii) = -third*(sig(i,1)+sig(i,2)+sig(i,3))
202 ENDDO
203
204 !-----------------------------------------
205 ! MATERIAL BOUNDARY : IMPOSED
206 !-----------------------------------------
207 ELSE
208
209 !MLW = 11
210 mx = mat(lft)
211 ivxfun = ipm(18,mx)
212 ivyfun = ipm(19,mx)
213 ivzfun = ipm(20,mx)
214 ityp = pm(50,mx)
215 vx0 = pm(101,mx)
216 vy0 = pm(102,mx)
217 vz0 = pm(103,mx)
218
219 IF(ityp == 2)THEN
220 t0 = zero
221
222 IF(ivxfun>0)THEN
223 vx = vx0*finter(ivxfun,t0,npf,tf,dydx)
224 ELSE
225 vx = vx0
226 ENDIF
227
228 IF(ivyfun>0)THEN
229 vy = vy0*finter(ivyfun,t0,npf,tf,dydx)
230 ELSE
231 vy = vy0
232 ENDIF
233
234 IF(ivzfun>0)THEN
235 vz = vz0*finter(ivzfun,t0,npf,tf,dydx)
236 ELSE
237 vz = vz0
238 ENDIF
239
240 DO i=lft,llt
241 ii = i+nft
242 mom(i,1) = vx*rho(i)
243 mom(i,2) = vy*rho(i)
244 mom(i,3) = vz*rho(i)
245 alefvm_buffer%FCELL(1,ii) = mom(i,1)
246 alefvm_buffer%FCELL(2,ii) = mom(i,2)
247 alefvm_buffer%FCELL(3,ii) = mom(i,3)
248 alefvm_buffer%FCELL(4,ii) = rho(i)
249 alefvm_buffer%FCELL(5,ii) = ssp(i)
250 alefvm_buffer%FCELL(6,ii) = -third*(sig(i,1)+sig(i,2)+sig(i,3))
251 ENDDO
252 ELSEIF(ityp == 3)THEN
253 t0 = zero
254 vx=zero
255 vy=zero
256 vz=zero
257 DO i=lft,llt
258 ii = i+nft
259 mom(i,1) = vx*rho(i)
260 mom(i,2) = vy*rho(i)
261 mom(i,3) = vz*rho(i)
262 alefvm_buffer%FCELL(1,ii) = mom(i,1)
263 alefvm_buffer%FCELL(2,ii) = mom(i,2)
264 alefvm_buffer%FCELL(3,ii) = mom(i,3)
265 alefvm_buffer%FCELL(4,ii) = rho(i)
266 alefvm_buffer%FCELL(5,ii) = ssp(i)
267 alefvm_buffer%FCELL(6,ii) = -third*(sig(i,1)+sig(i,2)+sig(i,3))
268 ENDDO
269 ENDIF
270
271 ENDIF
272
273
274C-----------------------------------------------
275 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alefvm_mod
Definition alefvm_mod.F:88
alefvm_mod::alefvm_buffer
type(alefvm_buffer_), target alefvm_buffer
Definition alefvm_mod.F:120
alefvm_mod::alefvm_param
type(alefvm_param_), target alefvm_param
Definition alefvm_mod.F:121