29 SUBROUTINE mhvis3(JFT,JLT ,PM ,THK,HOUR,
30 2 OFF,PX1 ,PX2,PY1,PY2 ,
31 3 IXC,DT1C,SSP,RHO,STI ,
32 4 EANI,GEO ,PID,STIR,MAT,
33 5 THK0,VISCMX,ALPE,IPARTC ,PARTSAV,
34 6 IHBE ,NFT ,ISMSTR , RX1,
35 7 RX2,RX3,RX4,RY1,RY2,
36 8 RY3,RY4,VX1,VX2,VX3,
37 9 VX4,VY1,VY2,VY3,VY4,
38 A VZ1,VZ2,VZ3,VZ4,B11,
39 B B12,B13,B14,B21,B22,
41 D VHX,VHY,H11,H12,H13,
42 E H14,H21,H22,H23,H24,
43 F H31,H32,H33,H34,H1 ,
44 G H2,IGEO,NEL,MTN,A1 )
48#include "implicit_f.inc"
69 INTEGER IXC(NIXC,*),IPARTC(*), JFT, JLT,PID(*),
70 . IHBE ,NFT ,ISMSTR,IGEO(NPROPGI, *),NEL,MTN
74 . PM(NPROPM,*), GEO(NPROPG,*), THK(*), HOUR(NEL,5), OFF(*),
75 . PX1(*), PX2(*), PY1(*), PY2(*),DT1C(*),EANI(*),
76 . SSP(MVSIZ), RHO(MVSIZ),STI(MVSIZ),STIR(*),
78 . THK0(MVSIZ),VISCMX(MVSIZ), ALPE(),PARTSAV(NPSAV,*)
81 . B11(MVSIZ), B12(MVSIZ), B13(MVSIZ), B14(MVSIZ), B21(MVSIZ),
82 . B22(MVSIZ), B23(MVSIZ), B24(MVSIZ), H11(MVSIZ), H12(MVSIZ),
83 . H13(MVSIZ), H14(MVSIZ), H21(MVSIZ), H22(MVSIZ), H23(MVSIZ),
84 . h24(mvsiz), h31(mvsiz), h32(mvsiz), h33(mvsiz), h34(mvsiz),
85 . rx1(mvsiz), rx2(mvsiz), rx3(mvsiz), rx4(mvsiz), ry1(mvsiz),
86 . ry2(mvsiz), ry3(mvsiz), ry4(mvsiz), vhx(mvsiz), vhy(mvsiz),
87 . vx1(mvsiz), vx2(mvsiz), vx3(mvsiz),
88 . vx4(mvsiz), vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz),
89 . vz1(mvsiz), vz2(mvsiz), vz3(mvsiz), vz4(mvsiz),
area(mvsiz),
91 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: a1
95 INTEGER I, MX,IPID,,IGMAT,IPGMAT
96 my_real H1L(MVSIZ), H2L(MVSIZ), H1Q(MVSIZ), (), HG1(MVSIZ),
97 . HG2(MVSIZ), FAC(MVSIZ), YM(MVSIZ), PR(MVSIZ),
98 . GAMA1(MVSIZ), GAMA2(MVSIZ), GAMA3(MVSIZ), GAMA4(MVSIZ),
99 . H4(MVSIZ), H4L(MVSIZ), H4Q(MVSIZ),(MVSIZ),
100 . G(MVSIZ) , B1(MVSIZ), B2(MVSIZ),A11(MVSIZ),EHOU(MVSIZ),
101 . PX1V, PX2V, PY1V, PY2V, EHOURT,VV ,SCALE(),FAC1
103 IF(ISMSTR /=3 .AND. ihbe >= 1)
THEN
109 gama1(i)= off(i)*( one- px1v-py1v)
110 gama3(i)= off(i)*( one+ px1v+py1v)
111 gama2(i)= off(i)*(-one- px2v-py2v)
112 gama4(i)= off(i)*(-one+ px2v+py2v)
139 fac(i)=fourth*rho(i)*thk0(i)
144 h4l(i)=fac(i)*sqrt(hvisc*h4(i)*
area(i))
145 h4q(i)=sqrt(hvisc*h4(i))*h4l(i)*hundred
150 thk02(i)= thk0(i)*thk0(i)
151 b1(i) = px1(i)*px1(i)+py1(i)*py1(i)
152 b2(i) = px2(i)*px2(i)+py2(i)*py2(i)
153 fac(i)=fourth*ym(i)*thk0(i)*dt1c(i)*helas
161 IF(ixc(4,i)/=ixc(5,i))cycle
178 igtyp = igeo(11,ipid)
179 igmat = igeo(98,ipid)
181 IF(nodadt /= 0 .OR. idt1sh == 1.OR. idtmins == 2)
THEN
184 scale(i)=
max(gama1(i)*gama1(i),gama2(i)*gama2(i),gama3(i)*gama3(i),gama4(i)*gama4(i)) *
185 . dt1c(i)*
max(h1(i)+h1l(i),h2(i)+h2l(i),h4l(i)) /
max(dt1c(i)*dt1c(i),em20)
186 sti(i)=sti(i) + scale(i)
188 IF(igtyp == 11 .AND. igmat > 0)
THEN
190 a11(i) = geo(ipgmat +5 ,pid(i))
191 g(i) = geo(ipgmat+4,pid(i))
192 a11r(i) = geo(ipgmat+7,pid(i))
193 IF (off(i)==zero)
THEN
197 vv = viscmx(i) * viscmx(i) * alpe(i)
198 fac1 =
max(b1(i),b2(i)) / (
area(i) * vv)
199 sti(i) = sti(i) + fac1* thk0(i) * a11(i)
200 stir(i) = fac1 * a11r(i)*one_over_12*thk0(i)**3 +
201 . fac1 * a11(i)*thk0(i)*
area(i)*one_over_9 +
202 . fac1*scale(i)*(one_over_12*thk0(i)**2 +
area(i)*one_over_9)
211 IF (mtn==58) a11(jft:jlt)=a1(jft:jlt)
213 IF (off(i)==zero)
THEN
217 vv = viscmx(i) * viscmx(i) * alpe(i)
218 sti(i) = sti(i) +
max(b1(i),b2(i)) * thk0(i) * a11(i) / (
area(i) * vv)
219 stir(i) = sti(i)*(thk02(i) * one_over_12 +
area(i) * one_over_9)
227 IF(ismstr == 3 .OR. ihbe < 1)
THEN
229 hg1(i)=vx1(i)-vx2(i)+vx3(i)-vx4(i)
230 hg2(i)=vy1(i)-vy2(i)+vy3(i)-vy4(i)
234 hour(i,1)=hour(i,1)+hg1(i)*h1(i)
235 hour(i,2)=hour(i,2)+hg2(i)*h1(i)
236 hg1(i)=hg1(i)*(h1l(i)+h1q(i)*abs(hg1(i)))
237 hg2(i)=hg2(i)*(h1l(i)+h1q(i)*abs(hg2(i)))
238 h11(i)= hour(i,1)+hg1(i)
239 h12(i)=-hour(i,1)-hg1(i)
240 h13(i)= hour(i,1)+hg1(i)
241 h14(i)=-hour(i,1)-hg1(i)
242 h21(i)= hour(i,2)+hg2(i)
243 h22(i)=-hour(i,2)-hg2(i)
244 h23(i)= hour(i,2)+hg2(i)
245 h24(i)=-hour(i,2)-hg2(i)
249 hg1(i)=vx1(i)*gama1(i)+vx2(i)*gama2(i)+vx3(i)*gama3(i)+vx4(i)*gama4(i)
250 hg2(i)=vy1(i)*gama1(i)+vy2(i)*gama2(i)+vy3(i)*gama3(i)+vy4(i)*gama4(i)
253 hour(i,1)=hour(i,1)+hg1(i)*h1(i)
254 hour(i,2)=hour(i,2)+hg2(i)*h1(i)
255 hg1(i)=hg1(i)*(h1l(i)+h1q(i)*abs(hg1(i)))
256 hg2(i)=hg2(i)*(h1l(i)+h1q(i)*abs(hg2(i)))
257 h11(i)=(hour(i,1)+hg1(i))*gama1(i)
258 h12(i)=(hour(i,1)+hg1(i))*gama2(i)
259 h13(i)=(hour(i,1)+hg1(i))*gama3(i)
260 h14(i)=(hour(i,1)+hg1(i))*gama4(i)
261 h21(i)=(hour(i,2)+hg2(i))*gama1(i)
262 h22(i)=(hour(i,2)+hg2(i))*gama2(i)
263 h23(i)=(hour(i,2)+hg2(i))*gama3(i)
264 h24(i)=(hour(i,2)+hg2(i))*gama4(i)
269 ehou(i) = vx1(i)*h11(i) + vx2(i)*h12(i) + vx3(i)*h13(i) + vx4(i)*h14(i)
270 . + vy1(i)*h21(i) + vy2(i)*h22(i) + vy3(i)*h23(i) + vy4(i)*h24(i)
275 IF(ismstr==3.OR.ihbe<1)
THEN
277 hg1(i)=vz1(i)-vz2(i)+vz3(i)-vz4(i)
281 hour(i,3)=hour(i,3)+hg1(i)*h2(i)
282 hg1(i)=hg1(i)*(h2l(i)+h2q(i)*abs(hg1(i)))
283 h31(i)= hour(i,3)+hg1(i)
284 h32(i)=-hour(i,3)-hg1(i)
285 h33(i)= hour(i,3)+hg1(i)
286 h34(i)=-hour(i,3)-hg1(i)
290 hg1(i)=vz1(i)*gama1(i)+vz2(i)*gama2(i)+vz3(i)*gama3(i)+vz4(i)*gama4(i)
293 hour(i,3)=hour(i,3)+hg1(i)*h2(i)
294 hg1(i)=hg1(i)*(h2l(i)+h2q(i)*abs(hg1(i)))
295 h31(i)=(hour(i,3)+hg1(i))*gama1(i)
296 h32(i)=(hour(i,3)+hg1(i))*gama2(i)
297 h33(i)=(hour(i,3)+hg1(i))*gama3(i)
298 h34(i)=(hour(i,3)+hg1(i))*gama4(i)
305 hg1(i)=+vz1(i)+vz2(i)-vz3(i)-vz4(i)
309 hg1(i)=hg1(i)*(h4l(i)+h4q(i)*abs(hg1(i)))
310 h31(i)=h31(i) +hg1(i)
311 h32(i)=h32(i) +hg1(i)
312 h33(i)=h33(i) -hg1(i)
313 h34(i)=h34(i) -hg1(i)
317 hg1(i)=vz1(i)-vz2(i)-vz3(i)+vz4(i)
321 hg1(i)=hg1(i)*(h4l(i)+h4q(i)*abs(hg1(i)))
322 h31(i)=h31(i) +hg1(i)
323 h32(i)=h32(i) -hg1(i)
324 h33(i)=h33(i) -hg1(i)
325 h34(i)=h34(i) +hg1(i)
340 ehou(i) = ehou(i) + vz1(i)*h31(i) + vz2(i)*h32(i) + vz3(i)*h33(i) + vz4(i)*h34(i)
341 ehou(i) = dt1c(i) * ehou(i)
342 ehourt = ehourt + ehou(i)
347 partsav(8,mx)=partsav(8,mx) + ehou(i)
351 ehour = ehour + ehourt
354 eani(nft+numels+i) = eani(nft+numels+i)+ehou(i)
subroutine mhvis3(jft, jlt, pm, thk, hour, off, px1, px2, py1, py2, ixc, dt1c, ssp, rho, sti, eani, geo, pid, stir, mat, thk0, viscmx, alpe, ipartc, partsav, ihbe, nft, ismstr, rx1, rx2, rx3, rx4, ry1, ry2, ry3, ry4, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, b11, b12, b13, b14, b21, b22, b23, b24, area, ym, pr, vhx, vhy, h11, h12, h13, h14, h21, h22, h23, h24, h31, h32, h33, h34, h1, h2, igeo, nel, mtn, a1)