OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
m51vois2.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 m51vois2 (pm, iparg, ixq, 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

◆ m51vois2()

subroutine m51vois2 ( pm,
integer, dimension(nparg,ngroup) iparg,
integer, dimension(nixq,numelq) ixq,
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,nummat) ipm,
bufmat,
integer, intent(in) nel,
integer nv46,
sspv,
epspv,
p0_nrf )

Definition at line 33 of file m51vois2.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 : nixq
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,INTENT(IN) :: NEL
65 INTEGER IPARG(NPARG,NGROUP),IXQ(NIXQ,NUMELQ),ITRIMAT,IPM(NPROPMI,NUMMAT),KK,ILAY, NV46
66 my_real
67 . pm(npropm,nummat), v(3,numnod),x(3,numnod),vn(nel),w(3,numnod),p0_nrf(mvsiz),
68 . vel(nel),bufmat(*),
69 . rhov(0:4,mvsiz), pv(0:4,mvsiz), eiv(0:4,mvsiz), avv(0:4,mvsiz), tv(0:4,mvsiz), rho0v(0:4,mvsiz),
70 . bufvois(m51_iflg6_size,*),sspv(0:4,mvsiz),epspv(0:4,mvsiz),
71 . vd2(nel),vdx(nel),vdy(nel),vdz(nel)
72 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
73 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I, II, J, IVOI, ML, N, KTY, KLT, MFT, IS,NELG,IJ(NV46),K,IAD2,IX1,IX2
78 INTEGER :: ICF(2,4), IFORM, IADBUF,ISUB_BIJ(4),ITMP
79 my_real :: xn, yn, zn, fac, vn1, vn2
80
81 TYPE(G_BUFEL_) ,POINTER :: GBUF
82 TYPE(BUF_MAT_) ,POINTER :: MBUF
83 TYPE(L_BUFEL_) ,POINTER :: LBUF
84 TYPE(BUF_LAY_) ,POINTER :: BUFLY
85C-----------------------------------------------
86 !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/
87 DATA icf/1,2,2,3,3,4,4,1/
88 ilay = 1
89C-----------------------------------------------
90 iform = -huge(iform)
91 ml = 0
92 ivoi = -huge(ivoi)
93 isub_bij(1:4) = -huge(isub_bij(1))
94 kty = -huge(kty)
95 klt = -huge(klt)
96 mft = -huge(mft)
97 DO i=1,nel
98 ii = i+nft
99 iad2 = ale_connect%ee_connect%iad_connect(ii)
100
101 DO j=1,nv46
102 ivoi=ale_connect%ee_connect%connected(iad2 + j - 1)
103 ml=51
104 iform=1000
105 IF(ivoi /= 0)THEN
106 IF(ivoi <= numelq)THEN
107 ml=nint(pm(19,ixq(1,ivoi)))
108 iadbuf=ipm(7,ixq(1,ivoi))
109 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,1or10)
110 isub_bij(1)=nint(bufmat(iadbuf+276+1-1))
111 isub_bij(2)=nint(bufmat(iadbuf+276+2-1))
112 isub_bij(3)=nint(bufmat(iadbuf+276+3-1))
113 isub_bij(4)=nint(bufmat(iadbuf+276+4-1))
114 ELSE
115 is=ivoi-numelq
116 iform=nint(bufvois(36,is))
117 itmp=nint(bufvois(37,is))
118 isub_bij(1)=(itmp/100000)
119 itmp=mod(itmp,100000)
120 isub_bij(2)=(itmp/10000)
121 itmp=mod(itmp,10000)
122 isub_bij(3)=(itmp/1000)
123 itmp=mod(itmp,1000)
124 isub_bij(4)=(itmp/100)
125 itmp=mod(itmp,100)
126 ml = itmp
127 ENDIF
128 ENDIF
129 IF(ml == 51 .AND. iform <= 1) EXIT ! If the neighboring material is law 51 iForm = 1 or 10 then we found
130 ENDDO
131
132 IF(ml == 51 .AND. iform<=1)THEN
133 ix1 = ixq(icf(1,j)+1,ii)
134 ix2 = ixq(icf(2,j)+1,ii)
135 xn = zero
136 yn = (-x(3,ix2)+x(3,ix1))
137 zn = (-x(2,ix1)+x(2,ix2))
138 fac = one/sqrt(yn**2+zn**2)
139 yn = yn*fac
140 zn = zn*fac
141 !
142 ! mean velocities at boundary face(supg)
143 !
144 vdx(i)=zero
145 vdy(i)=half*(v(2,ix1)+v(2,ix2))
146 vdz(i)=half*(v(3,ix1)+v(3,ix2))
147 IF(jale > 0)THEN
148 vdy(i)=vdy(i)-half*(w(2,ix1)+w(2,ix2))
149 vdz(i)=vdz(i)-half*(w(3,ix1)+w(3,ix2))
150 ENDIF
151 vd2(i)=vdy(i)**2+vdz(i)**2
152 IF(vdy(i)*zn+vdz(i)*yn <= zero)THEN
153 vdy(i)=zero
154 vdz(i)=zero
155 ENDIF
156 !
157 ! FRONTIERE NON REFLECHISSANTE
158 !
159 vn1=v(2,ix1)*yn+v(3,ix1)*zn
160 vn2=v(2,ix2)*yn+v(3,ix2)*zn
161 vel(i)=(min(vn1,vn2))**2
162 vn(i)=half*(vn1+vn2)
163 IF(vn(i) >= zero)vel(i)=zero
164
165 IF(ivoi <= numelq)THEN
166 !processor element
167 DO n=1,ngroup
168 kty = iparg(5,n)
169 klt = iparg(2,n)
170 mft = iparg(3,n)
171 IF (kty == 2 .AND. ivoi <= klt+mft) EXIT
172 ENDDO
173
174 IF (kty /= 2 .OR. ivoi > klt+mft) cycle
175 gbuf => elbuf_tab(n)%GBUF
176 lbuf => elbuf_tab(n)%BUFLY(1)%LBUF(1,1,1)
177 mbuf => elbuf_tab(n)%BUFLY(1)%MAT(1,1,1)
178 bufly => elbuf_tab(n)%BUFLY(1)
179 nelg = klt
180 is = ivoi-mft
181
182 DO k=1,nv46
183 ij(k) = klt*(k-1)
184 ENDDO
185
186 !Global Material data
187 pv(0,i) = -third*(gbuf%SIG(ij(1)+is)
188 . + gbuf%SIG(ij(2)+is)
189 . + gbuf%SIG(ij(3)+is))
190 avv(0,i) = one
191 eiv(0,i) = gbuf%EINT(is)
192 rhov(0,i) = gbuf%RHO(is)
193 tv(0,i) = gbuf%TEMP(is) !IF (JTHE>0)
194 sspv(0,i) = lbuf%SSP(is)
195 IF(bufly%L_PLA > 0)then
196 epspv(0,i) = lbuf%PLA(is)
197 ELSE
198 epspv(0,i) = zero
199 ENDIF
200 p0_nrf(i) = mbuf%VAR(nelg*3+is) !UVAR(4,I)
201
202 !Submaterial Data
203 DO itrimat=1,4
204 kk = m51_n0phas + (itrimat-1)*m51_nvphas
205 iadbuf=18 ; pv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
206 !IADBUF=1 ; AVV(ITRIMAT,I) = MBUF%VAR(NELG*(IADBUF+KK-1)+IS)
207 iadbuf=8 ; eiv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
208 iadbuf=9 ; rhov(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
209 iadbuf=16 ; tv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
210 iadbuf=14 ; sspv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
211 iadbuf=15 ; epspv(itrimat,i)= mbuf%VAR(nelg*(iadbuf+kk-1)+is)
212 !IADBUF=20 ; RHOFv(ITRIMAT,I)= MBUF%VAR(NELG*(IADBUF+KK-1)+IS)
213 !IADBUF=21 ; EFv(ITRIMAT,I) = MBUF%VAR(NELG*(IADBUF+KK-1)+IS)
214 !IADBUF=22 ; PFv(ITRIMAT,I) = MBUF%VAR(NELG*(IADBUF+KK-1)+IS)
215 ENDDO
216
217 !volue fractions
218 DO itrimat=1,4
219 kk = m51_n0phas + (isub_bij(itrimat)-1)*m51_nvphas
220 iadbuf=1 ; avv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
221 ENDDO
222
223 iadbuf = ipm(7,ixq(1,ivoi))
224
225 rho0v(1,i) = bufmat(iadbuf+09-1) !UPARAM(9) = RHO10
226 rho0v(2,i) = bufmat(iadbuf+10-1) !UPARAM(10) = RHO20
227 rho0v(3,i) = bufmat(iadbuf+11-1) !UPARAM(11) = RHO30
228 rho0v(4,i) = bufmat(iadbuf+47-1) !UPARAM(47) = RHO40
229 rho0v(0,i) = bufmat(iadbuf+69-1) !UPARAM(69) = RHO0
230
231 ELSE !(IVOI>NUMELQ)
232
233 !SPMD case and remote adjacent : retrieve from BUFVOIS
234 !BUFVOIS filled in ALEMAIN (spmf_cfd.F : SPMD_L51VOIS)
235
236 is = ivoi-numelq
237 pv(0,i) = bufvois(01,is)
238 eiv(0,i) = bufvois(02,is)
239 rhov(0,i) = bufvois(03,is)
240 tv(0,i) = bufvois(04,is)
241 sspv(0,i) = bufvois(05,is)
242 epspv(0,i) = bufvois(06,is)
243
244 itrimat = 1
245 pv(itrimat,i) = bufvois(07,is)
246 !AVV(ITRIMAT,I) = BUFVOIS(08,IS)
247 eiv(itrimat,i) = bufvois(09,is)
248 rhov(itrimat,i) = bufvois(10,is)
249 tv(itrimat,i) = bufvois(11,is)
250 sspv(itrimat,i) = bufvois(12,is)
251 epspv(itrimat,i)= bufvois(13,is)
252
253 itrimat = 2
254 pv(itrimat,i) = bufvois(14,is)
255 !AVV(ITRIMAT,I) = BUFVOIS(15,IS)
256 eiv(itrimat,i) = bufvois(16,is)
257 rhov(itrimat,i) = bufvois(17,is)
258 tv(itrimat,i) = bufvois(18,is)
259 sspv(itrimat,i) = bufvois(19,is)
260 epspv(itrimat,i) = bufvois(20,is)
261
262 itrimat = 3
263 pv(itrimat,i) = bufvois(21,is)
264 !AVV(ITRIMAT,I) = BUFVOIS(22,IS)
265 eiv(itrimat,i) = bufvois(23,is)
266 rhov(itrimat,i) = bufvois(24,is)
267 tv(itrimat,i) = bufvois(25,is)
268 sspv(itrimat,i) = bufvois(26,is)
269 epspv(itrimat,i) = bufvois(27,is)
270
271 itrimat = 4
272 pv(itrimat,i) = bufvois(28,is)
273 !AVV(ITRIMAT,I) = BUFVOIS(29,IS)
274 eiv(itrimat,i) = bufvois(30,is)
275 rhov(itrimat,i) = bufvois(31,is)
276 tv(itrimat,i) = bufvois(32,is)
277 sspv(itrimat,i) = bufvois(33,is)
278 epspv(itrimat,i) = bufvois(34,is)
279
280 p0_nrf(i) = bufvois(35,is)
281
282 !ordering with bijection uparam(276+1:276+4)
283 avv(1,i) = bufvois(1+isub_bij(1)*7,is)
284 avv(2,i) = bufvois(1+isub_bij(2)*7,is)
285 avv(3,i) = bufvois(1+isub_bij(3)*7,is)
286 avv(4,i) = bufvois(1+isub_bij(4)*7,is)
287
288 ENDIF
289
290 ELSE !(ML/=51.OR.IFORM>1)
291 vn(i) = zero
292 pv(0:4,i) = zero
293 eiv(0:4,i) = zero
294 rhov(0:4,i) = zero
295 tv(0:4,i) = zero
296 avv(0:4,i) = zero
297 sspv(0:4,i) = zero
298 epspv(0:4,i)= zero
299 ENDIF
300 ENDDO !next i
301C-----------
302 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