31 SUBROUTINE mhvis3(JFT,JLT ,PM ,THK,HOUR,
32 2 OFF,PX1 ,PX2,PY1,PY2 ,
33 3 IXC,DT1C,SSP,RHO,STI ,
34 4 EANI,GEO ,PID,STIR,MAT,
35 5 THK0,VISCMX,ALPE,IPARTC ,PARTSAV,
36 6 IHBE ,NFT ,ISMSTR , RX1,
37 7 RX2,RX3,RX4,RY1,RY2,
38 8 RY3,RY4,VX1,VX2,VX3,
39 9 VX4,VY1,VY2,VY3,VY4,
40 A VZ1,VZ2,VZ3,VZ4,B11,
41 B B12,B13,B14,B21,B22,
43 D VHX,VHY,H11,H12,H13,
44 E H14,H21,H22,H23,H24,
45 F H31,H32,H33,H34,H1 ,
46 G H2,IGEO,NEL,MTN,A1 )
50 use element_mod ,
only : nixc
54#include "implicit_f.inc"
75 INTEGER IXC(NIXC,*),IPARTC(*), JFT, JLT,PID(*),
76 . IHBE ,NFT ,ISMSTR,IGEO(NPROPGI, *),NEL,MTN
80 . (NPROPM,*), GEO(NPROPG,*), (*), HOUR(NEL,5), OFF(*),
81 . PX1(*), PX2(*), PY1(*), PY2(*),DT1C(*),EANI(*),
82 . SSP(MVSIZ), RHO(MVSIZ),STI(MVSIZ),STIR(*),
83 . H1(MVSIZ), H2(MVSIZ),
84 . THK0(MVSIZ),VISCMX(MVSIZ), ALPE(MVSIZ),(NPSAV,*)
87 . B11(MVSIZ), B12(MVSIZ), B13(MVSIZ), B14(MVSIZ), B21(MVSIZ),
88 . B22(MVSIZ), B23(MVSIZ), B24(), H11(MVSIZ), H12(MVSIZ),
89 . H13(MVSIZ), H14(MVSIZ), H21(MVSIZ), H22(MVSIZ), H23(MVSIZ),
90 . h24(mvsiz), h31(mvsiz), h32(mvsiz), h33(mvsiz), h34(mvsiz),
91 . rx1(mvsiz), rx2(mvsiz), rx3(mvsiz), rx4(mvsiz), ry1(mvsiz),
92 . ry2(mvsiz), ry3(mvsiz), ry4(mvsiz), vhx(mvsiz), vhy(mvsiz),
93 . vx1(mvsiz), vx2(mvsiz), vx3(mvsiz),
94 . vx4(mvsiz), vy1(mvsiz), vy2(mvsiz), vy3(mvsiz), vy4(mvsiz),
95 . vz1(mvsiz), vz2(mvsiz), vz3(mvsiz), vz4(mvsiz),
area(mvsiz),
97 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: a1
101 INTEGER I, MX,IPID,IGTYP,IGMAT,IPGMAT
102 my_real H1L(MVSIZ), H2L(MVSIZ), H1Q(MVSIZ), H2Q(MVSIZ), HG1(MVSIZ),
103 . HG2(MVSIZ), FAC(MVSIZ), YM(MVSIZ), PR(MVSIZ),
104 . GAMA1(MVSIZ), GAMA2(MVSIZ), GAMA3(MVSIZ), GAMA4(MVSIZ),
105 . H4(MVSIZ), H4L(MVSIZ), H4Q(MVSIZ),THK02(MVSIZ),
106 . G(MVSIZ) , B1(MVSIZ), B2(MVSIZ),A11(MVSIZ),EHOU(MVSIZ),
107 . , PX2V, PY1V, PY2V, EHOURT,VV ,SCALE(MVSIZ),FAC1
109 IF(ISMSTR /=3 .AND. ihbe >= 1)
THEN
115 gama1(i)= off(i)*( one- px1v-py1v)
116 gama3(i)= off(i)*( one+ px1v+py1v)
117 gama2(i)= off(i)*(-one- px2v-py2v)
118 gama4(i)= off(i)*(-one+ px2v+py2v)
145 fac(i)=fourth*rho(i)*thk0(i)
150 h4l(i)=fac(i)*sqrt(hvisc*h4(i)*
area(i))
151 h4q(i)=sqrt(hvisc*h4(i))*h4l(i)*hundred
156 thk02(i)= thk0(i)*thk0(i)
157 b1(i) = px1(i)*px1(i)+py1(i)*py1(i)
158 b2(i) = px2(i)*px2(i)+py2(i)*py2(i)
159 fac(i)=fourth*ym(i)*thk0(i)*dt1c(i)*helas
167 IF(ixc(4,i)/=ixc(5,i))cycle
184 igtyp = igeo(11,ipid)
185 igmat = igeo(98,ipid)
187 IF(nodadt /= 0 .OR. idt1sh == 1.OR. idtmins == 2)
THEN
190 scale(i)=
max(gama1(i)*gama1(i),gama2(i)*gama2(i),gama3(i)*gama3(i),gama4(i)*gama4(i)) *
191 . dt1c(i)*
max(h1(i)+h1l(i),h2(i)+h2l(i),h4l(i)) /
max(dt1c(i)*dt1c(i),em20)
192 sti(i)=sti(i) + scale(i)
194 IF(igtyp == 11 .AND. igmat > 0)
THEN
196 a11(i) = geo(ipgmat +5 ,pid(i))
197 g(i) = geo(ipgmat+4,pid(i))
198 a11r(i) = geo(ipgmat+7,pid(i))
199 IF (off(i)==zero)
THEN
203 vv = viscmx(i) * viscmx(i) * alpe(i)
204 fac1 =
max(b1(i),b2(i)) / (
area(i) * vv)
205 sti(i) = sti(i) + fac1* thk0(i) * a11(i)
206 stir(i) = fac1 * a11r(i)*one_over_12*thk0(i)**3 +
207 . fac1 * a11(i)*thk0(i)*
area(i)*one_over_9 +
208 . fac1*scale(i)*(one_over_12*thk0(i)**2 +
area(i)*one_over_9)
217 IF (mtn==58) a11(jft:jlt)=a1(jft:jlt)
219 IF (off(i)==zero)
THEN
223 vv = viscmx(i) * viscmx(i) * alpe(i)
224 sti(i) = sti(i) +
max(b1(i),b2(i)) * thk0(i) * a11(i) / (
area(i) * vv)
225 stir(i) = sti(i)*(thk02(i) * one_over_12 +
area(i) * one_over_9)
233 IF(ismstr == 3 .OR. ihbe < 1)
THEN
235 hg1(i)=vx1(i)-vx2(i)+vx3(i)-vx4(i)
236 hg2(i)=vy1(i)-vy2(i)+vy3(i)-vy4(i)
240 hour(i,1)=hour(i,1)+hg1(i)*h1(i)
241 hour(i,2)=hour(i,2)+hg2(i)*h1(i)
242 hg1(i)=hg1(i)*(h1l(i)+h1q(i)*abs(hg1(i)))
243 hg2(i)=hg2(i)*(h1l(i)+h1q(i)*abs(hg2(i)))
244 h11(i)= hour(i,1)+hg1(i)
245 h12(i)=-hour(i,1)-hg1(i)
246 h13(i)= hour(i,1)+hg1(i)
247 h14(i)=-hour(i,1)-hg1(i)
248 h21(i)= hour(i,2)+hg2(i)
249 h22(i)=-hour(i,2)-hg2(i)
250 h23(i)= hour(i,2)+hg2(i)
251 h24(i)=-hour(i,2)-hg2(i)
255 hg1(i)=vx1(i)*gama1(i)+vx2(i)*gama2(i)+vx3(i)*gama3(i)+vx4(i)*gama4(i)
256 hg2(i)=vy1(i)*gama1(i)+vy2(i)*gama2(i)+vy3(i)*gama3(i)+vy4(i)*gama4(i)
259 hour(i,1)=hour(i,1)+hg1(i)*h1(i)
260 hour(i,2)=hour(i,2)+hg2(i)*h1(i)
261 hg1(i)=hg1(i)*(h1l(i)+h1q(i)*abs(hg1(i)))
262 hg2(i)=hg2(i)*(h1l(i)+h1q(i)*abs(hg2(i)))
263 h11(i)=(hour(i,1)+hg1(i))*gama1(i)
264 h12(i)=(hour(i,1)+hg1(i))*gama2(i)
265 h13(i)=(hour(i,1)+hg1(i))*gama3(i)
266 h14(i)=(hour(i,1)+hg1(i))*gama4(i)
267 h21(i)=(hour(i,2)+hg2(i))*gama1(i)
268 h22(i)=(hour(i,2)+hg2(i))*gama2(i)
269 h23(i)=(hour(i,2)+hg2(i))*gama3(i)
270 h24(i)=(hour(i,2)+hg2(i))*gama4(i)
275 ehou(i) = vx1(i)*h11(i) + vx2(i)*h12(i) + vx3(i)*h13(i) + vx4(i)*h14(i)
276 . + vy1(i)*h21(i) + vy2(i)*h22(i) + vy3(i)*h23(i) + vy4(i)*h24(i)
281 IF(ismstr==3.OR.ihbe<1)
THEN
283 hg1(i)=vz1(i)-vz2(i)+vz3(i)-vz4(i)
287 hour(i,3)=hour(i,3)+hg1(i)*h2(i)
288 hg1(i)=hg1(i)*(h2l(i)+h2q(i)*abs(hg1(i)))
289 h31(i)= hour(i,3)+hg1(i)
290 h32(i)=-hour(i,3)-hg1(i)
291 h33(i)= hour(i,3)+hg1(i)
292 h34(i)=-hour(i,3)-hg1(i)
296 hg1(i)=vz1(i)*gama1(i)+vz2(i)*gama2(i)+vz3(i)*gama3(i)+vz4(i)*gama4(i)
299 hour(i,3)=hour(i,3)+hg1(i)*h2(i)
300 hg1(i)=hg1(i)*(h2l(i)+h2q(i)*abs(hg1(i)))
301 h31(i)=(hour(i,3)+hg1(i))*gama1(i)
302 h32(i)=(hour(i,3)+hg1(i))*gama2(i)
303 h33(i)=(hour(i,3)+hg1(i))*gama3(i)
304 h34(i)=(hour(i,3)+hg1(i))*gama4(i)
315 hg1(i)=hg1(i)*(h4l(i)+h4q(i)*abs(hg1(i)))
316 h31(i)=h31(i) +hg1(i)
317 h32(i)=h32(i) +hg1(i)
318 h33(i)=h33(i) -hg1(i)
319 h34(i)=h34(i) -hg1(i)
323 hg1(i)=vz1(i)-vz2(i)-vz3(i)+vz4(i)
327 hg1(i)=hg1(i)*(h4l(i)+h4q(i)*abs(hg1(i)))
328 h31(i)=h31(i) +hg1(i)
329 h32(i)=h32(i) -hg1(i)
330 h33(i)=h33(i) -hg1(i)
331 h34(i)=h34(i) +hg1(i)
346 ehou(i) = ehou(i) + vz1(i)*h31(i) + vz2(i)*h32(i) + vz3(i)*h33(i) + vz4(i)*h34(i)
347 ehou(i) = dt1c(i) * ehou(i)
348 ehourt = ehourt + ehou(i)
353 partsav(8,mx)=partsav(8,mx) + ehou(i)
357 ehour = ehour + ehourt
360 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)