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 32 of file m51vois3.F.

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