33 SUBROUTINE m51vois2(PM ,IPARG ,IXQ ,ALE_CONNECT ,ELBUF_TAB,V ,
34 2 X ,VN ,W ,VEL ,VD2 ,
35 3 RHOV ,PV ,VDX ,VDY ,VDZ ,
36 4 EIV ,TV ,BUFVOIS,AVV ,RHO0V ,
38 6 NV46 ,SSPv ,EPSPv ,P0_NRF )
44 USE multimat_param_mod ,
ONLY : m51_n0phas, m51_nvphas, m51_iflg6_size
45 use element_mod ,
only : nixq
49#include "implicit_f.inc"
59#include "vect01_c.inc"
64 INTEGER,
INTENT(IN) :: NEL
65 INTEGER IPARG(NPARG,NGROUP),IXQ(NIXQ,NUMELQ),ITRIMAT,IPM(NPROPMI,NUMMAT),KK,ILAY, NV46
67 . PM(NPROPM,NUMMAT), V(3,NUMNOD),X(3,NUMNOD),VN(NEL),W(3,NUMNOD),P0_NRF(MVSIZ),
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
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
81 TYPE(G_BUFEL_) ,
POINTER :: GBUF
82 TYPE(buf_mat_) ,
POINTER :: MBUF
83 TYPE(l_bufel_) ,
POINTER :: LBUF
84 TYPE(buf_lay_) ,
POINTER :: BUFLY
87 DATA icf/1,2,2,3,3,4,4,1/
93 isub_bij(1:4) = -huge(isub_bij(1))
99 iad2 = ale_connect%ee_connect%iad_connect(ii)
102 ivoi=ale_connect%ee_connect%connected
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))
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))
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)
122 isub_bij(3)=(itmp/1000)
124 isub_bij(4)=(itmp/100)
129 IF(ml == 51 .AND. iform <= 1)
EXIT
132 IF(ml == 51 .AND. iform<=1)
THEN
133 ix1 = ixq(icf(1,j)+1,ii)
134 ix2 = ixq(icf(2,j)+1,ii)
136 yn = (-x(3,ix2)+x(3,ix1))
137 zn = (-x(2,ix1)+x(2,ix2))
138 fac = one/sqrt(yn**2+zn**2)
145 vdy(i)=half*(v(2,ix1)+v(2,ix2))
146 vdz(i)=half*(v(3,ix1)+v(3,ix2))
148 vdy(i)=vdy(i)-half*(w(2,ix1)+w(2,ix2))
149 vdz(i)=vdz(i)-half*(w(3,ix1)+w(3,ix2))
151 vd2(i)=vdy(i)**2+vdz(i)**2
152 IF(vdy(i)*zn+vdz(i)*yn <= zero)
THEN
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
163 IF(vn(i) >= zero)vel(i)=zero
165 IF(ivoi <= numelq)
THEN
171 IF (kty == 2 .AND. ivoi <= klt+mft)
EXIT
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)
187 pv(0,i) = -third*(gbuf%SIG(ij(1)+is)
188 . + gbuf%SIG(ij(2)+is)
189 . + gbuf%SIG(ij(3)+is))
191 eiv(0,i) = gbuf%EINT(is)
192 rhov(0,i) = gbuf%RHO(is)
193 tv(0,i) = gbuf%TEMP(is)
194 sspv(0,i) = lbuf%SSP(is)
195 IF(bufly%L_PLA > 0)
then
196 epspv(0,i) = lbuf%PLA(is)
200 p0_nrf(i) = mbuf%VAR(nelg*3+is)
204 kk = m51_n0phas + (itrimat-1)*m51_nvphas
205 iadbuf=18 ; pv(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)
219 kk = m51_n0phas + (isub_bij(itrimat)-1)*m51_nvphas
220 iadbuf=1 ; avv(itrimat,i) = mbuf%VAR(nelg*(iadbuf+kk-1)+is)
223 iadbuf = ipm(7,ixq(1,ivoi))
225 rho0v(1,i) = bufmat(iadbuf+09-1)
226 rho0v(2,i) = bufmat(iadbuf+10-1)
227 rho0v(3,i) = bufmat(iadbuf+11-1)
228 rho0v(4,i) = bufmat(iadbuf+47-1)
229 rho0v(0,i) = bufmat(iadbuf+69-1)
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)
245 pv(itrimat,i) = bufvois(07,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)
254 pv(itrimat,i) = bufvois(14,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)
263 pv(itrimat,i) = bufvois(21,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)
272 pv(itrimat,i) = bufvois(28,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
280 p0_nrf(i) = bufvois(35,is)
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)