38 . LISTE,NOD,IRECT,IELEM,IFACE,
39 . LA,EBCS,IPARG,ELBUF_TAB,MULTI_FVM,IXQ,IXS,IXTG,
40 . ELEM_ADRESS,FSKY,FSAVSURF)
47 USE multimat_param_mod ,
ONLY : m51_n0phas, m51_nvphas
51#include "implicit_f.inc"
64 INTEGER,
INTENT(IN) :: NSEG,NOD,ISEG(NSEG),(NOD),IRECT(4,),IELEM(NSEG),IFACE(NSEG)
65 INTEGER,
INTENT(IN) :: IXQ(NIXQ,NUMELQ),(NIXS,NUMELS),IXTG(NIXTG,NUMELTG)
66 my_real,
INTENT(INOUT) :: A(3,NUMNOD)
67 my_real v(3,numnod),w(3,numnod),x(3,numnod),la(3,nod)
68 TYPE(t_ebcs_nrf),
INTENT(INOUT) :: EBCS
69 INTEGER :: IPARG(NPARG,NGROUP)
70 TYPE(),
TARGET,
DIMENSION(NGROUP) :: ELBUF_TAB
71 TYPE(multi_fvm_struct),
INTENT(IN) :: MULTI_FVM
72 TYPE(
t_segvar),
INTENT(INOUT) :: SEGVAR
73 INTEGER,
DIMENSION(4,NSEG),
INTENT(IN) :: ELEM_ADRESS
74 my_real,
DIMENSION(8,LSKY),
INTENT(INOUT) :: fsky
78 TYPE(g_bufel_),
POINTER :: GBUF
79 TYPE(L_BUFEL_) ,
POINTER :: LBUF
80 INTEGER II,IS,KK,KSEG,NN(4),NNG(4),NUM,KTY,KLT,MFT,NGRP,ILOC,NPT,IVOI,IDX(6),IX(4)
81 INTEGER (2,4), ICF_3d(4,6), JJ, ISUBMAT, IPOS, NBMAT, MTN
82 my_real orient,rho,roc,fac1,fac2,vol,mass,
83 . x13,y13,z13,x24,y24,z24,
84 .
alpha, beta, v0(3,nod),
85 . xn, yn, zn, tmp(3), vold, vnew, pold, pvois,
86 . dp0,mach,pp,ssp,rhoc2,
87 . tcar_p, tcar_vf, surf, time, eint,phase_alpha(21),phase_rho(21), phase_eint(21)
89 TYPE(BUF_MAT_) ,
POINTER :: MBUF
93 DATA icf_2d /1,2,2,3,3,4,4,1/
94 DATA icf_3d /1,4,3,2,3,4,8,7,5,6,7,8,1,2,6,5,2,3,7,6,1,5,8,4/
99 tcar_vf = ebcs%TCAR_VF
101 surf_id = ebcs%SURF_ID
104 beta = dt1/
max(dt1,tcar_vf)
105 IF(tcar_vf>=ep20)beta=zero
115 v0(1,ii)=v(1,num)-w(1,num)
116 v0(2,ii)=v(2,num)-w(2,num)
117 v0(3,ii)=v(3,num)-w(3,num)
119 ELSEIF(ieuler == 1)
THEN
138 orient=float(iseg(is)/kseg)
143 ix(1)=ixs(icf_3d(1,jj)+1,ielem(is))
144 ix(2)=ixs(icf_3d(2,jj)+1,ielem(is))
145 ix(3)=ixs(icf_3d(3,jj)+1,ielem(is))
146 ix(4)=ixs(icf_3d(4,jj)+1,ielem(is))
147 x13=x(1,ix(3))-x(1,ix(1))
148 y13=x(2,ix(3))-x(2,ix(1))
149 z13=x(3,ix(3))-x(3,ix(1))
150 x24=x(1,ix(4))-x(1,ix(2))
151 y24=x(2,ix(4))-x(2,ix(2))
152 z24=x(3,ix(4))-x(3,ix(2))
156 fac2=one/sqrt(xn**2+yn**2+zn**2)
161 IFTHEN ; npt=3;fac1=third; else; npt=4;fac1=fourth;
ENDIF
167 ix(1) = ixtg(icf_2d(1,jj)+1,ielem(is))
168 ix(2) = ixtg(icf_2d(2,jj)+1,ielem(is))
170 ix(1) = ixq(icf_2d(1,jj)+1,ielem(is))
171 ix(2) = ixq(icf_2d(2,jj)+1,ielem(is))
174 yn = -(-x(3,ix(2))+x(3,ix(1)))
175 zn = (-x(2,ix(2))+x(2,ix(1)))
176 fac2 = one/sqrt(yn*yn+zn*zn)
194 tmp(1) = tmp(1) + v0(1,nn(kk))
195 tmp(2) = tmp(2) + v0(2,nn(kk))
196 tmp(3) = tmp(3) + v0(3,nn(kk))
199 vnew = fac1 * (tmp(1)*xn + tmp(2)*yn + tmp(3)*zn)
200 IF(time == zero)
THEN
201 IF(
ale%GRID%NWALE == 7)
THEN
221 IF(kty /= 2 .AND. kty /= 7)cycle
223 IF (ivoi <= klt+mft)
THEN
229 gbuf => elbuf_tab(ngrp)%GBUF
230 lbuf => elbuf_tab(ngrp)%BUFLY(1)%LBUF(1,1,1)
238 pvois = -third*(gbuf%SIG(idx(1)+iloc+1) + gbuf%SIG(idx(2)+iloc+1) + gbuf%SIG(idx(3)+iloc+1))
240 IF(time == zero)pold=pvois+dp0
243 rho = gbuf%RHO(iloc+1)
250 IF(multi_fvm%IS_USED)
THEN
251 ssp = multi_fvm%SOUND_SPEED(ivoi)
253 ssp = lbuf%SSP(iloc+1)
257 eint = gbuf%EINT(iloc+1)
261 mbuf => elbuf_tab(ngrp)%BUFLY(1)%MAT(1,1,1)
264 kk = (m51_n0phas + (isubmat-1)*m51_nvphas +ipos-1) * klt + iloc+1
265 phase_alpha(isubmat) =
267 kk = (m51_n0phas + (isubmat-1)*m51_nvphas +ipos-1) * klt + iloc+1
268 phase_rho(isubmat) = mbuf%VAR(kk)
270 kk = (m51_n0phas + (isubmat-1)*m51_nvphas +ipos-1) * klt + iloc+1
271 phase_eint(isubmat) = mbuf%VAR(kk)
273 ELSEIF(mtn == 151)
THEN
274 DO isubmat=1,multi_fvm%NBMAT
275 phase_alpha(isubmat) = multi_fvm%PHASE_ALPHA(isubmat,iloc+1+klt)
276 phase_rho(isubmat) = multi_fvm%PHASE_RHO(isubmat,iloc+1+klt)
277 phase_eint(isubmat) = multi_fvm%PHASE_EINT(isubmat,iloc+1+klt)
284 segvar%EINT(kseg)=eint
285 IF(segvar%has_phase_alpha)segvar%PHASE_ALPHA(1:4,kseg)=phase_alpha(1:4)
286 IF(segvar%has_phase_rho)segvar%PHASE_RHO(1:4,kseg)=phase_rho(1:4)
287 IF(segvar%has_phase_eint)segvar%PHASE_EINT(1:4,kseg)=phase_eint(1:4)
291 IF(ssp /= zero)mach = abs(vnew / ssp)
293 IF(mach >= one .AND. vnew > zero)
THEN
300 pp = one/(one+
alpha)*(pold+roc*(vnew-vold))+
alpha*(pvois+dp0)/(
alpha + one)
305 IF(segvar%nbmat > 0)
THEN
311 phase_alpha(isubmat)=(one-beta)*phase_alpha(isubmat)
312 . + beta*mbuf%VAR((m51_n0phas+(isubmat-1)*m51_nvphas +23-1)* klt+iloc+1)
314 ELSEIF(mtn == 151)
THEN
318 segvar%PHASE_ALPHA(1:4,kseg) = phase_alpha(1:4)
323 la(1,nn(kk)) = la(1,nn(kk)) - pp*surf*xn*fac1
324 la(2,nn(kk)) = la(2,nn(kk)) - pp*surf*yn*fac1
325 la(3,nn(kk)) = la(3,nn(kk)) - pp*surf*zn*fac1
329 fsavsurf(2,surf_id) = fsavsurf(2,surf_id) + rho*surf*vnew
330 fsavsurf(3,surf_id) = fsavsurf(3,surf_id) + surf*vnew
331 fsavsurf(4,surf_id) = fsavsurf(4,surf_id) + surf*pp
332 fsavsurf(6,surf_id) = fsavsurf(6,surf_id) + rho*surf*vnew*dt1
338 adress = elem_adress(kk,is)
339 fsky(1,adress) = -pp*surf*xn*fac1
341 fsky(3,adress) = -pp*surf*zn*fac1
353 a(1,num)=a(1,num)+la(1,ii)
354 a(2,num)=a(2,num)+la(2,ii)
355 a(3,num)=a(3,num)+la(3,ii)