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

Go to the source code of this file.

Functions/Subroutines

subroutine m51vois3 (pm, iparg, ixs, ale_connect, elbuf_tab, v, x, vn, w, vel, vd2, rhov, pv, vdx, vdy, vdz, eiv, tv, bufvois, avv, rho0v, ipm, bufmat, nel, nv46, sspv, epspv, p0_nrf)

Function/Subroutine Documentation

◆ m51vois3()

subroutine m51vois3 ( pm,
integer, dimension(nparg,ngroup) iparg,
integer, dimension(nixs,numels) ixs,
type(t_ale_connectivity), intent(in) ale_connect,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
v,
x,
vn,
w,
vel,
vd2,
rhov,
pv,
vdx,
vdy,
vdz,
eiv,
tv,
bufvois,
avv,
rho0v,
integer, dimension(npropmi,*) ipm,
bufmat,
integer nel,
integer nv46,
sspv,
epspv,
p0_nrf )

Definition at line 33 of file m51vois3.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE elbufdef_mod
43 USE ale_connectivity_mod
44 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas, m51_iflg6_size
45 use element_mod , only : nixs
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "vect01_c.inc"
60#include "param_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER IPARG(NPARG,NGROUP),IXS(NIXS,NUMELS),ITRIMAT,
65 . IPM(NPROPMI,*),NEL,
66 . ILAY, NV46
67 my_real
68 . pm(npropm,nummat), v(3,numnod),x(3,numnod),vn(*),w(3,*),p0_nrf(mvsiz),
69 . vel(*),bufmat(*),
70 . rhov(0:4,mvsiz), pv(0:4,mvsiz), eiv(0:4,mvsiz), avv(0:4,mvsiz), tv(0:4,mvsiz), rho0v(0:4,mvsiz),
71 . bufvois(m51_iflg6_size,*),sspv(0:4,mvsiz),epspv(0:4,mvsiz),
72 . vd2(nel),vdx(nel),vdy(nel),vdz(nel)
73 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
74 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I, II,J, IVOI, ML, N, KTY, KLT, MFT, IS,
79 . IX1, IX2, IX3, IX4, NELG,KK,K,IJ(NV46)
80 INTEGER ICF(4,6), IFORM, IADBUF,ISUB_BIJ(4),ITMP
81 my_real
82 . x13, y13, z13, x24, y24, z24, xn, yn, zn, fac, vn1, vn2,
83 . vn3, vn4
84 INTEGER IAD2
85
86 TYPE(G_BUFEL_) ,POINTER :: GBUF
87 TYPE(BUF_MAT_) ,POINTER :: MBUF
88 TYPE(L_BUFEL_) ,POINTER :: LBUF
89 TYPE(BUF_LAY_) ,POINTER :: BUFLY
90C-----------------------------------------------
91 DATA icf/1,4,3,2,3,4,8,7,5,6,7,8,1,2,6,5,2,3,7,6,1,5,8,4/
92 !DATA ICF/1,2,2,3,3,4,4,1/
93 ilay = 1
94C-----------------------------------------------
95 ml = 0
96 mft = -huge(mft)
97 kty = -huge(kty)
98 klt = -huge(klt)
99 iform = -huge(iform)
100 ivoi = -huge(ivoi)
101 isub_bij(1:4) = -huge(isub_bij(1))
102 DO i=1,nel
103 ii = i+nft
104 iad2 = ale_connect%ee_connect%iad_connect(ii)
105 DO j=1,nv46
106 ivoi = ale_connect%ee_connect%connected(iad2 + j - 1)
107 ml = 51
108 iform = 1000
109 IF(ivoi>0)THEN
110 IF(ivoi<=numels)THEN
111 ml = nint(pm(19,ixs(1,ivoi)))
112 iadbuf = ipm(7,ixs(1,ivoi))
113 IF(ml==51)iform = nint(bufmat(iadbuf+31-1)) !if adjacent elem has mat 51 then we retrieve UPARAM(31)=IFLG (IFLG=0,1 pour IFROM=0,1 or 10)
114 isub_bij(1)=nint(bufmat(iadbuf+276+1-1))
115 isub_bij(2)=nint(bufmat(iadbuf+276+2-1))
116 isub_bij(3)=nint(bufmat(iadbuf+276+3-1))
117 isub_bij(4)=nint(bufmat(iadbuf+276+4-1))
118 ELSE
119 is = ivoi-numels
120 iform = nint(bufvois(36,is))
121 itmp = nint(bufvois(37,is))
122 isub_bij(1)=(itmp/100000)
123 itmp=mod(itmp,100000)
124 isub_bij(2)=(itmp/10000)
125 itmp=mod(itmp,10000)
126 isub_bij(3)=(itmp/1000)
127 itmp=mod(itmp,1000)
128 isub_bij(4)=(itmp/100)
129 itmp=mod(itmp,100)
130 ml = itmp
131 ENDIF
132 ENDIF
133 IF(ml == 51 .AND. iform <= 1) EXIT ! If the neighboring material is law 51 iForm = 1 or 10 then we found
134 ENDDO
135
136 IF(ml == 51 .AND. iform <= 1)THEN
137 ix1 = ixs(icf(1,j)+1,ii)
138 ix2 = ixs(icf(2,j)+1,ii)
139 ix3 = ixs(icf(3,j)+1,ii)
140 ix4 = ixs(icf(4,j)+1,ii)
141 x13 = x(1,ix3)-x(1,ix1)
142 y13 = x(2,ix3)-x(2,ix1)
143 z13 = x(3,ix3)-x(3,ix1)
144 x24 = x(1,ix4)-x(1,ix2)
145 y24 = x(2,ix4)-x(2,ix2)
146 z24 = x(3,ix4)-x(3,ix2)
147 xn = -y13*z24+z13*y24
148 yn = -z13*x24+x13*z24
149 zn = -x13*y24+y13*x24
150 fac = one/sqrt(xn**2+yn**2+zn**2)
151 xn = xn*fac
152 yn = yn*fac
153 zn = zn*fac
154 !
155 ! mean velocities at boundary faces
156 !
157 vdx(i)=fourth*(v(1,ix1)+v(1,ix2)+v(1,ix3)+v(1,ix4))
158 vdy(i)=fourth*(v(2,ix1)+v(2,ix2)+v(2,ix3)+v(2,ix4))
159 vdz(i)=fourth*(v(3,ix1)+v(3,ix2)+v(3,ix3)+v(3,ix4))
160 IF(jale>0)THEN
161 vdx(i)=vdx(i)-fourth*(w(1,ix1)+w(1,ix2)+w(1,ix3)+w(1,ix4))
162 vdy(i)=vdy(i)-fourth*(w(2,ix1)+w(2,ix2)+w(2,ix3)+w(2,ix4))
163 vdz(i)=vdz(i)-fourth*(w(3,ix1)+w(3,ix2)+w(3,ix3)+w(3,ix4))
164 ENDIF
165 vd2(i)=vdx(i)**2+vdy(i)**2+vdz(i)**2
166 IF(vdx(i)*xn+vdy(i)*yn+vdz(i)*zn <=zero)THEN
167 vdx(i)=zero
168 vdy(i)=zero
169 vdz(i)=zero
170 ENDIF
171 !
172 ! FRONTIERE NON REFLECHISSANTE
173 !
174 vn1=v(1,ix1)*xn+v(2,ix1)*yn+v(3,ix1)*zn
175 vn2=v(1,ix2)*xn+v(2,ix2)*yn+v(3,ix2)*zn
176 vn3=v(1,ix3)*xn+v(2,ix3)*yn+v(3,ix3)*zn
177 vn4=v(1,ix4)*xn+v(2,ix4)*yn+v(3,ix4)*zn
178 vel(i)=(min(vn1,vn2,vn3,vn4))**2
179 vn(i)=fourth*(vn1+vn2+vn3+vn4)
180 IF(vn(i) >= zero)vel(i)=zero
181
182 IF(ivoi <= numels)THEN
183 !processor element
184 DO n=1,ngroup
185 kty = iparg(5,n)
186 klt = iparg(2,n)
187 mft = iparg(3,n)
188 IF (kty == 1 .AND. ivoi <= klt+mft) EXIT
189 ENDDO
190
191 IF (kty /= 1 .OR. ivoi > klt+mft) cycle
192 gbuf => elbuf_tab(n)%GBUF
193 lbuf => elbuf_tab(n)%BUFLY(1)%LBUF(1,1,1)
194 mbuf => elbuf_tab(n)%BUFLY(1)%MAT(1,1,1)
195 bufly => elbuf_tab(n)%BUFLY(1)
196 nelg = klt
197 is = ivoi-mft
198!
199 DO k=1,6
200 ij(k) = klt*(k-1)
201 ENDDO
202!
203 !Global Material data
204 pv(0,i) = -third*(gbuf%SIG(ij(1)+is)
205 . + gbuf%SIG(ij(2)+is)
206 . + gbuf%SIG(ij(3)+is))
207 avv(0,i) = one
208 eiv(0,i) = gbuf%EINT(is)
209 rhov(0,i) = gbuf%RHO(is)
210 tv(0,i) = gbuf%TEMP(is) !IF (JTHE>0)
211 sspv(0,i) = lbuf%SSP(is)
212 IF(bufly%L_PLA>0)then
213 epspv(0,i) = lbuf%PLA(is)
214 ELSE
215 epspv(0,i) = zero
216 ENDIF
217 p0_nrf(i) = mbuf%VAR(nelg*3+is) !UVAR(4,I)
218
219 !Submaterial Data
220 DO itrimat=1,4
221 kk = m51_n0phas + (itrimat-1)*m51_nvphas
222 iadbuf=18 ; pv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
223 iadbuf=1 ; avv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
224 iadbuf=8 ; eiv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
225 iadbuf=9 ; rhov(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
226 iadbuf=16 ; tv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
227 iadbuf=14 ; sspv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
228 iadbuf=15 ; epspv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
229 ENDDO
230
231 !volume fractions
232 DO itrimat=1,4
233 kk = m51_n0phas + (isub_bij(itrimat)-1)*m51_nvphas
234 iadbuf=1 ; avv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
235 ENDDO
236
237
238 iadbuf = ipm(7,ixs(1,ivoi))
239
240 rho0v(1,i) = bufmat(iadbuf+09-1) !UPARAM(9) = RHO10
241 rho0v(2,i) = bufmat(iadbuf+10-1) !UPARAM(10) = RHO20
242 rho0v(3,i) = bufmat(iadbuf+11-1) !UPARAM(11) = RHO30
243 rho0v(4,i) = bufmat(iadbuf+47-1) !UPARAM(47) = RHO40
244 rho0v(0,i) = bufmat(iadbuf+69-1) !UPARAM(69) = RHO0
245
246 ELSE !(IVOI>NUMELS)
247
248 !spmd case and remote neighbor: fetch from bufvois
249 !BUFVOIS filled in Alemain (SPMF_CFD.F: SPMD_L51VOIS)
250
251 is = ivoi-numels
252 pv(0,i) = bufvois(01,is)
253 eiv(0,i) = bufvois(02,is)
254 rhov(0,i) = bufvois(03,is)
255 tv(0,i) = bufvois(04,is)
256 sspv(0,i) = bufvois(05,is)
257 epspv(0,i) = bufvois(06,is)
258
259 itrimat = 1
260 pv(itrimat,i) = bufvois(07,is)
261 !AVV(ITRIMAT,I) = BUFVOIS(08,IS)
262 eiv(itrimat,i) = bufvois(09,is)
263 rhov(itrimat,i) = bufvois(10,is)
264 tv(itrimat,i) = bufvois(11,is)
265 sspv(itrimat,i) = bufvois(12,is)
266 epspv(itrimat,i) = bufvois(13,is)
267
268 itrimat = 2
269 pv(itrimat,i) = bufvois(14,is)
270 !AVV(ITRIMAT,I) = BUFVOIS(15,IS)
271 eiv(itrimat,i) = bufvois(16,is)
272 rhov(itrimat,i) = bufvois(17,is)
273 tv(itrimat,i) = bufvois(18,is)
274 sspv(itrimat,i) = bufvois(19,is)
275 epspv(itrimat,i) = bufvois(20,is)
276
277 itrimat = 3
278 pv(itrimat,i) = bufvois(21,is)
279 !AVV(ITRIMAT,I) = BUFVOIS(22,IS)
280 eiv(itrimat,i) = bufvois(23,is)
281 rhov(itrimat,i) = bufvois(24,is)
282 tv(itrimat,i) = bufvois(25,is)
283 sspv(itrimat,i) = bufvois(26,is)
284 epspv(itrimat,i) = bufvois(27,is)
285
286 itrimat = 4
287 pv(itrimat,i) = bufvois(28,is)
288 !AVV(ITRIMAT,I) = BUFVOIS(29,IS)
289 eiv(itrimat,i) = bufvois(30,is)
290 rhov(itrimat,i) = bufvois(31,is)
291 tv(itrimat,i) = bufvois(32,is)
292 sspv(itrimat,i) = bufvois(33,is)
293 epspv(itrimat,i) = bufvois(34,is)
294
295 p0_nrf(i) = bufvois(35,is)
296
297 !ordering with bijection uparam(276+1:276+4)
298 avv(1,i) = bufvois(1+isub_bij(1)*7,is)
299 avv(2,i) = bufvois(1+isub_bij(2)*7,is)
300 avv(3,i) = bufvois(1+isub_bij(3)*7,is)
301 avv(4,i) = bufvois(1+isub_bij(4)*7,is)
302
303 ENDIF
304
305 ELSE !(ML/=51.OR.IFORM>1)
306 vn(i) = zero
307 pv(0:4,i) = zero
308 eiv(0:4,i) = zero
309 rhov(0:4,i) = zero
310 tv(0:4,i) = zero
311 avv(0:4,i) = zero
312 sspv(0:4,i) = zero
313 epspv(0:4,i)= zero
314 ENDIF
315 ENDDO !next i
316C-----------
317 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
ale_connectivity_mod
Definition ale_connectivity_mod.F:225