OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
m51vois2.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| m51vois2 ../engine/source/materials/mat/mat051/m51vois2.F
25!||--- called by ------------------------------------------------------
26!|| sigeps51_boundary_material ../engine/source/materials/mat/mat051/sigeps51_boundary_material.F90
27!||--- uses -----------------------------------------------------
28!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
29!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
30!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
31!||====================================================================
32 SUBROUTINE m51vois2(PM ,IPARG ,IXQ ,ALE_CONNECT ,ELBUF_TAB,V ,
33 2 X ,VN ,W ,VEL ,VD2 ,
34 3 RHOV ,PV ,VDX ,VDY ,VDZ ,
35 4 EIV ,TV ,BUFVOIS,AVV ,RHO0V ,
36 5 IPM ,BUFMAT ,NEL ,
37 6 NV46 ,SSPv ,EPSPv ,P0_NRF )
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,INTENT(IN) :: NEL
63 INTEGER IPARG(NPARG,NGROUP),IXQ(NIXQ,NUMELQ),ITRIMAT,IPM(NPROPMI,NUMMAT),KK,ILAY, NV46
64 my_real
65 . PM(NPROPM,NUMMAT), V(3,NUMNOD),X(3,NUMNOD),VN(NEL),W(3,NUMNOD),P0_NRF(MVSIZ),
66 . VEL(NEL),BUFMAT(*),
67 . rhov(0:4,mvsiz), pv(0:4,mvsiz), eiv(0:4,mvsiz), avv(0:4,mvsiz), tv(0:4,mvsiz), rho0v(0:4,mvsiz),
68 . bufvois(m51_iflg6_size,*),sspv(0:4,mvsiz),epspv(0:4,mvsiz),
69 . vd2(nel),vdx(nel),vdy(nel),vdz(nel)
70 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
71 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECT
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I, II, J, IVOI, ML, N, KTY, KLT, MFT, IS,NELG,IJ(NV46),K,IAD2,IX1,IX2
76 INTEGER :: ICF(2,4), IFORM, IADBUF,ISUB_BIJ(4),ITMP
77 my_real :: XN, YN, ZN, FAC, VN1, VN2
78
79 TYPE(G_BUFEL_) ,POINTER :: GBUF
80 TYPE(buf_mat_) ,POINTER :: MBUF
81 TYPE(l_bufel_) ,POINTER :: LBUF
82 TYPE(buf_lay_) ,POINTER :: BUFLY
83C-----------------------------------------------
84 !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/
85 DATA icf/1,2,2,3,3,4,4,1/
86 ilay = 1
87C-----------------------------------------------
88 iform = -huge(iform)
89 ml = 0
90 ivoi = -huge(ivoi)
91 isub_bij(1:4) = -huge(isub_bij(1))
92 kty = -huge(kty)
93 klt = -huge(klt)
94 mft = -huge(mft)
95 DO i=1,nel
96 ii = i+nft
97 iad2 = ale_connect%ee_connect%iad_connect(ii)
98
99 DO j=1,nv46
100 ivoi=ale_connect%ee_connect%connected(iad2 + j - 1)
101 ml=51
102 iform=1000
103 IF(ivoi /= 0)THEN
104 IF(ivoi <= numelq)THEN
105 ml=nint(pm(19,ixq(1,ivoi)))
106 iadbuf=ipm(7,ixq(1,ivoi))
107 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)
108 isub_bij(1)=nint(bufmat(iadbuf+276+1-1))
109 isub_bij(2)=nint(bufmat(iadbuf+276+2-1))
110 isub_bij(3)=nint(bufmat(iadbuf+276+3-1))
111 isub_bij(4)=nint(bufmat(iadbuf+276+4-1))
112 ELSE
113 is=ivoi-numelq
114 iform=nint(bufvois(36,is))
115 itmp=nint(bufvois(37,is))
116 isub_bij(1)=(itmp/100000)
117 itmp=mod(itmp,100000)
118 isub_bij(2)=(itmp/10000)
119 itmp=mod(itmp,10000)
120 isub_bij(3)=(itmp/1000)
121 itmp=mod(itmp,1000)
122 isub_bij(4)=(itmp/100)
123 itmp=mod(itmp,100)
124 ml = itmp
125 ENDIF
126 ENDIF
127 IF(ml == 51 .AND. iform <= 1) EXIT ! si materiau voisin est loi 51 Iform=1 ou 10 alors on a trouve
128 ENDDO
129
130 IF(ml == 51 .AND. iform<=1)THEN
131 ix1 = ixq(icf(1,j)+1,ii)
132 ix2 = ixq(icf(2,j)+1,ii)
133 xn = zero
134 yn = (-x(3,ix2)+x(3,ix1))
135 zn = (-x(2,ix1)+x(2,ix2))
136 fac = one/sqrt(yn**2+zn**2)
137 yn = yn*fac
138 zn = zn*fac
139 !
140 ! mean velocities at boundary face(supg)
141 !
142 vdx(i)=zero
143 vdy(i)=half*(v(2,ix1)+v(2,ix2))
144 vdz(i)=half*(v(3,ix1)+v(3,ix2))
145 IF(jale > 0)THEN
146 vdy(i)=vdy(i)-half*(w(2,ix1)+w(2,ix2))
147 vdz(i)=vdz(i)-half*(w(3,ix1)+w(3,ix2))
148 ENDIF
149 vd2(i)=vdy(i)**2+vdz(i)**2
150 IF(vdy(i)*zn+vdz(i)*yn <= zero)THEN
151 vdy(i)=zero
152 vdz(i)=zero
153 ENDIF
154 !
155 ! FRONTIERE NON REFLECHISSANTE
156 !
157 vn1=v(2,ix1)*yn+v(3,ix1)*zn
158 vn2=v(2,ix2)*yn+v(3,ix2)*zn
159 vel(i)=(min(vn1,vn2))**2
160 vn(i)=half*(vn1+vn2)
161 IF(vn(i) >= zero)vel(i)=zero
162
163 IF(ivoi <= numelq)THEN
164 !element du processeur
165 DO n=1,ngroup
166 kty = iparg(5,n)
167 klt = iparg(2,n)
168 mft = iparg(3,n)
169 IF (kty == 2 .AND. ivoi <= klt+mft) EXIT
170 ENDDO
171
172 IF (kty /= 2 .OR. ivoi > klt+mft) cycle
173 gbuf => elbuf_tab(n)%GBUF
174 lbuf => elbuf_tab(n)%BUFLY(1)%LBUF(1,1,1)
175 mbuf => elbuf_tab(n)%BUFLY(1)%MAT(1,1,1)
176 bufly => elbuf_tab(n)%BUFLY(1)
177 nelg = klt
178 is = ivoi-mft
179
180 DO k=1,nv46
181 ij(k) = klt*(k-1)
182 ENDDO
183
184 !Global Material data
185 pv(0,i) = -third*(gbuf%SIG(ij(1)+is)
186 . + gbuf%SIG(ij(2)+is)
187 . + gbuf%SIG(ij(3)+is))
188 avv(0,i) = one
189 eiv(0,i) = gbuf%EINT(is)
190 rhov(0,i) = gbuf%RHO(is)
191 tv(0,i) = gbuf%TEMP(is) !IF (JTHE>0)
192 sspv(0,i) = lbuf%SSP(is)
193 IF(bufly%L_PLA > 0)then
194 epspv(0,i) = lbuf%PLA(is)
195 ELSE
196 epspv(0,i) = zero
197 ENDIF
198 p0_nrf(i) = mbuf%VAR(nelg*3+is) !UVAR(4,I)
199
200 !Submaterial Data
201 DO itrimat=1,4
202 kk = m51_n0phas + (itrimat-1)*m51_nvphas
203 iadbuf=18 ; pv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
204 !IADBUF=1 ; AVV(ITRIMAT,I) = MBUF%VAR(NELG*(IADBUF+KK-1)+IS)
205 iadbuf=8 ; eiv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
206 iadbuf=9 ; rhov(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
207 iadbuf=16 ; tv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
208 iadbuf=14 ; sspv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
209 iadbuf=15 ; epspv(itrimat,i)= mbuf%VAR(nelg*(iadbuf+kk-1)+is)
210 !IADBUF=20 ; RHOFv(ITRIMAT,I)= MBUF%VAR(NELG*(IADBUF+KK-1)+IS)
211 !IADBUF=21 ; EFv(ITRIMAT,I) = MBUF%VAR(NELG*(IADBUF+KK-1)+IS)
212 !IADBUF=22 ; PFv(ITRIMAT,I) = MBUF%VAR(NELG*(IADBUF+KK-1)+IS)
213 ENDDO
214
215 !volue fractions
216 DO itrimat=1,4
217 kk = m51_n0phas + (isub_bij(itrimat)-1)*m51_nvphas
218 iadbuf=1 ; avv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
219 ENDDO
220
221 iadbuf = ipm(7,ixq(1,ivoi))
222
223 rho0v(1,i) = bufmat(iadbuf+09-1) !UPARAM(9) = RHO10
224 rho0v(2,i) = bufmat(iadbuf+10-1) !UPARAM(10) = RHO20
225 rho0v(3,i) = bufmat(iadbuf+11-1) !UPARAM(11) = RHO30
226 rho0v(4,i) = bufmat(iadbuf+47-1) !UPARAM(47) = RHO40
227 rho0v(0,i) = bufmat(iadbuf+69-1) !UPARAM(69) = RHO0
228
229 ELSE !(IVOI>NUMELQ)
230
231 !SPMD case and remote adjacent : retrieve from BUFVOIS
232 !BUFVOIS filled in ALEMAIN (spmf_cfd.F : SPMD_L51VOIS)
233
234 is = ivoi-numelq
235 pv(0,i) = bufvois(01,is)
236 eiv(0,i) = bufvois(02,is)
237 rhov(0,i) = bufvois(03,is)
238 tv(0,i) = bufvois(04,is)
239 sspv(0,i) = bufvois(05,is)
240 epspv(0,i) = bufvois(06,is)
241
242 itrimat = 1
243 pv(itrimat,i) = bufvois(07,is)
244 !AVV(ITRIMAT,I) = BUFVOIS(08,IS)
245 eiv(itrimat,i) = bufvois(09,is)
246 rhov(itrimat,i) = bufvois(10,is)
247 tv(itrimat,i) = bufvois(11,is)
248 sspv(itrimat,i) = bufvois(12,is)
249 epspv(itrimat,i)= bufvois(13,is)
250
251 itrimat = 2
252 pv(itrimat,i) = bufvois(14,is)
253 !AVV(ITRIMAT,I) = BUFVOIS(15,IS)
254 eiv(itrimat,i) = bufvois(16,is)
255 rhov(itrimat,i) = bufvois(17,is)
256 tv(itrimat,i) = bufvois(18,is)
257 sspv(itrimat,i) = bufvois(19,is)
258 epspv(itrimat,i) = bufvois(20,is)
259
260 itrimat = 3
261 pv(itrimat,i) = bufvois(21,is)
262 !AVV(ITRIMAT,I) = BUFVOIS(22,IS)
263 eiv(itrimat,i) = bufvois(23,is)
264 rhov(itrimat,i) = bufvois(24,is)
265 tv(itrimat,i) = bufvois(25,is)
266 sspv(itrimat,i) = bufvois(26,is)
267 epspv(itrimat,i) = bufvois(27,is)
268
269 itrimat = 4
270 pv(itrimat,i) = bufvois(28,is)
271 !AVV(ITRIMAT,I) = BUFVOIS(29,IS)
272 eiv(itrimat,i) = bufvois(30,is)
273 rhov(itrimat,i) = bufvois(31,is)
274 tv(itrimat,i) = bufvois(32,is)
275 sspv(itrimat,i) = bufvois(33,is)
276 epspv(itrimat,i) = bufvois(34,is)
277
278 p0_nrf(i) = bufvois(35,is)
279
280 !ordering with bijection uparam(276+1:276+4)
281 avv(1,i) = bufvois(1+isub_bij(1)*7,is)
282 avv(2,i) = bufvois(1+isub_bij(2)*7,is)
283 avv(3,i) = bufvois(1+isub_bij(3)*7,is)
284 avv(4,i) = bufvois(1+isub_bij(4)*7,is)
285
286 ENDIF
287
288 ELSE !(ML/=51.OR.IFORM>1)
289 vn(i) = zero
290 pv(0:4,i) = zero
291 eiv(0:4,i) = zero
292 rhov(0:4,i) = zero
293 tv(0:4,i) = zero
294 avv(0:4,i) = zero
295 sspv(0:4,i) = zero
296 epspv(0:4,i)= zero
297 ENDIF
298 ENDDO !next i
299C-----------
300 RETURN
301 END
m51vois2
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)
Definition m51vois2.F:38
min
#define min(a, b)
Definition macros.h:20
ale_connectivity_mod
Definition ale_connectivity_mod.F:223