37 . MS ,STIFN ,STIFR ,WEIGHT ,IRECT ,
38 . NSV ,IRTL ,CRST ,SKEW ,XINI ,
39 . DX ,FINI ,FSAV ,FNCONT ,NSN ,
40 . I0 ,I2SIZE ,IADI2 ,FSKYI2 ,STFN ,
41 . STFR ,VISC ,PENFLAG ,IROT ,NOINT ,
42 . NODNX_SMS,DMINT2 ,DT2T ,NELTST ,ITYPTST ,
52#include "implicit_f.inc"
61 INTEGER NSN, I0,I2SIZE,PENFLAG,, NOINT,NELTST,ITYPTST
62 INTEGER IRECT(4,*),NSV(*),IRTL(*),WEIGHT(*),IADI2(4,*),
68 . X(3,*),VR(3,*),V(3,*),A(3,*),AR(3,*),MS(*),CRST(2,*),
69 . skew(9,*),dx(3,*),xini(3,*),fini(3,*),fsav(*),fncont(3,*),
70 . stifn(*),stifr(*),stfn(*),stfr(*),fskyi2(i2size,*),
71 . dmint2(4,*),fncontp(3,*) ,ftcontp(3,*)
72 TYPE (H3D_DATABASE) :: H3D_DATA
86 INTEGER NIR,I,J,II,JJ,L,W,NN,KK,K,LLT,
87 . IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
91 . S,T,SP,SM,TP,TM,ECONTT,ECONVT,E1X,E1Y,E1Z,E2X,E2Y,E2Z,E3X,E3Y,E3Z,
92 . FNORM,FLX,FLY,FLZ,FS(3),DDX,DDY,DDZ,XSM,YSM,ZSM,XM,YM,ZM,
93 . X1,X2,X3,X4,Y1,Y2,Y3,Y4,Z1,Z2,Z3,Z4,X0,Y0,Z0,XS,YS,ZS,STIFMS,
94 . vx1,vx2,vx3,vx4,vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4,dlx,dly,dlz,
95 . vx0,vy0,vz0,vsx,vsy,vsz,vmx,vmy,vmz,v1,v2,v3,dtinv,stf,
96 . fxv,fyv,fzv,drx,dry,drz,stbrk,dti,mharm,dkm, dxt
98 . h(4,mvsiz),fn(3),ft(3),fx(4),fy(4),fz(4),fmx(4),fmy(4),fmz(4),
99 . rx(4),ry(4),rz(4),rm(3),rs(3),v0(3),vs(3),vm(3),dxold(3),
100 . stif(mvsiz), vis(mvsiz), stifm(mvsiz),va(3),vb(3),vc(3),vd(3),
112 llt=
min(nsn-kk+1,mvsiz)
133 tp = fourth*(one + t)
134 tm = fourth*(one - t)
146 IF (ix3(k) == ix4(k))
THEN
148 h(3,k) = h(3,k) + h(4,k)
185 CALL i2rep(x1 ,x2 ,x3 ,x4 ,
190 . e3x ,e3y ,e3z ,nir )
193 xm = x1*h(1,k) + x2*h(2,k) + x3*h(3,k) + x4*h(4,k)
195 zm = z1*h(1,k) + z2*h(2,k) + z3*h(3,k) + z4*h(4,k)
196 x0 = (x1 + x2 + x3 + x4)/nir
197 y0 = (y1 + y2 + y3 + y4)/nir
198 z0 = (z1 + z2 + z3 + z4)/nir
210 vx0 = (vx1 + vx2 + vx3 + vx4)/nir
211 vy0 = (vy1 + vy2 + vy3 + vy4)/nir
212 vz0 = (vz1 + vz2 + vz3 + vz4)/nir
213 vmx = vx1*h(1,k) + vx2*h(2,k) + vx3*h(3,k) + vx4*h(4,k) - vx0
214 vmy = vy1*h(1,k) + vy2*h(2,k) + vy3*h(3,k) + vy4*h(4,k) - vy0
215 vmz = vz1*h(1,k) + vz2*h(2,k) + vz3*h(3,k) + vz4*h(4,k) - vz0
217 x0 = (x1 + x2 + x3)/nir
218 y0 = (y1 + y2 + y3)/nir
219 z0 = (z1 + z2 + z3)/nir
221 xm = x1*h(1,k) + x2*h(2,k) + x3*h(3,k)
222 ym = y1*h(1,k) + y2*h(2,k) + y3*h(3,k)
223 zm = z1*h(1,k) + z2*h(2,k) + z3*h(3,k)
235 vx0 = (vx1 + vx2 + vx3)/nir
236 vy0 = (vy1 + vy2 + vy3)/nir
237 vz0 = (vz1 + vz2 + vz3)/nir
238 vmx = vx1*h(1,k) + vx2*h(2,k) + vx3*h(3,k) - vx0
239 vmy = vy1*h(1,k) + vy2*h(2,k) + vy3*h(3,k) - vy0
240 vmz = vz1*h(1,k) + vz2*h(2,k) + vz3*h(3,k) - vz0
260 rs(1) = xs*e1x + ys*e1y + zs*e1z
261 rs(2) = xs*e2x + ys*e2y + zs*e2z
262 rs(3) = xs*e3x + ys*e3y + zs*e3z
263 rm(1) = xm*e1x + ym*e1y + zm
264 rm(2) = xm*e2x + ym*e2y + zm*e2z
265 rm(3) = xm*e3x + ym*e3y + zm*e3z
267 rx(1) = e1x*x1 + e1y*y1 + e1z*z1
268 ry(1) = e2x*x1 + e2y*y1 + e2z*z1
269 rz(1) = e3x*x1 + e3y*y1 + e3z*z1
270 rx(2) = e1x*x2 + e1y*y2 + e1z*z2
271 ry(2) = e2x*x2 + e2y*y2 + e2z*z2
272 rz(2) = e3x*x2 + e3y*y2 + e3z*z2
273 rx(3) = e1x*x3 + e1y*y3 + e1z*z3
274 ry(3) = e2x*x3 + e2y*y3 + e2z*z3
275 rz(3) = e3x*x3 + e3y*y3 + e3z*z3
276 rx(4) = e1x*x4 + e1y*y4 + e1z*z4
277 ry(4) = e2x*x4 + e2y*y4 + e2z*z4
278 rz(4) = e3x*x4 + e3y*y4 + e3z*z4
286 vs(1) = vsx*e1x + vsy*e1y + vsz*e1z
287 vs(2) = vsx*e2x + vsy*e2y + vsz*e2z
288 vs(3) = vsx*e3x + vsy*e3y + vsz*e3z
289 vm(1) = vmx*e1x + vmy*e1y + vmz*e1z
290 vm(2) = vmx*e2x + vmy*e2y + vmz*e2z
291 vm(3) = vmx*e3x + vmy*e3y + vmz*e3z
293 va(1) = vx1*e1x + vy1*e1y + vz1*e1z
294 va(2) = vx1*e2x + vy1*e2y + vz1*e2z
295 va(3) = vx1*e3x + vy1*e3y + vz1*e3z
297 vb(1) = vx2*e1x + vy2*e1y + vz2*e1z
298 vb(2) = vx2*e2x + vy2*e2y + vz2*e2z
299 vb(3) = vx2*e3x + vy2*e3y + vz2*e3z
301 vc(1) = vx3*e1x + vy3*e1y + vz3*e1z
302 vc(2) = vx3*e2x + vy3*e2y + vz3*e2z
303 vc(3) = vx3*e3x + vy3*e3y + vz3*e3z
305 vd(1) = vx4*e1x + vy4*e1y + vz4*e1z
306 vd(2) = vx4*e2x + vy4*e2y + vz4*e2z
307 vd(3) = vx4*e3x + vy4*e3y + vz4*e3z
323 CALL i2pen_rot(skew(1,ii) ,tt ,dt1 ,stbrk,
324 . rs ,rm ,v1 ,v2 ,v3 ,
325 . rx ,ry ,rz ,va ,vb ,
332 dx(1,ii) = dx(1,ii) + dlx
333 dx(2,ii) = dx(2,ii) + dly
334 dx(3,ii) = dx(3,ii) + dlz
339 flx = dx(1,ii) * stfn(ii)
340 fly = dx(2,ii) * stfn(ii)
341 flz = dx(3,ii) * stfn(ii)
347 ELSEIF(ms(i)==zero.OR.ms(ix1(k))==zero.OR.
348 . ms(ix2(k))==zero.OR.
349 . ms(ix3(k))==zero.OR.
350 . ms(ix4(k))==zero)
THEN
355 . one/ms(ix1(k)) + one/ms(ix2(k)) + one/ms(ix3(k)) + one/ms(ix4(k))
359 . one/ms(ix1(k)) + one/ms(ix2(k)) + one/ms(ix3(k))
362 dkm = two*stfn(ii)*mharm
363 vis(k) = visc*sqrt(dkm)
369 dxt = dx(1,ii)**2 + dx(2,ii)**2 + dx(3,ii)**2
370 econtt = econtt + half*stfn(ii)*dxt*w
372 econvt = econvt + (fxv*v1 + fyv*v2 + fzv*v3)*dt1*w
385 CALL i2loceq( nir ,rs ,rx ,ry ,rz ,
386 . fmx ,fmy ,fmz ,h(1,k) ,stifm(k))
391 fx(j) = e1x*fmx(j) + e2x*fmy(j) + e3x*fmz(j)
392 fy(j) = e1y*fmx(j) + e2y*fmy(j) + e3y*fmz(j)
393 fz(j) = e1z*fmx(j) + e2z*fmy(j) + e3z*fmz(j)
399 fs(1) = fs(1) + fx(j)
400 fs(2) = fs(2) + fy(j)
401 fs(3) = fs(3) + fz(j)
403 a(1,i) = a(1,i) - fs(1)
404 a(2,i) = a(2,i) - fs(2)
405 a(3,i) = a(3,i) - fs(3)
410 IF (dt1 > zero) dtinv=one/dt1
411 stf = (one+stbrk)*stfn(ii) + two*vis(k)*dtinv
413 stf = stfn(ii)*(viscl + sqrt(viscl**2 + (one+stbrk)))**2
416 stifn(i) = stifn(i) + stf
419 stif(k) = (one+stbrk)*stfn(ii)
428 fskyi2(1,nn) = fx(jj)
429 fskyi2(2,nn) = fy(jj)
430 fskyi2(3,nn) = fz(jj)
432 fskyi2(5,nn) = abs(stf*h(jj,k))+stifm(k)*stf
433 IF (iroddl == 1)
THEN
443 fskyi2(1,nn) = fx(jj)
444 fskyi2(2,nn) = fy(jj)
445 fskyi2(3,nn) = fz(jj)
447 fskyi2(5,nn) = abs(stf*h(jj,k))+stifm(k)*stf
448 IF (iroddl == 1)
THEN
458 fskyi2(1,nn) = fx(jj)
459 fskyi2(2,nn) = fy(jj)
460 fskyi2(3,nn) = fz(jj)
462 fskyi2(5,nn) = abs(stf*h(jj,k))+stifm(k)*stf
463 IF (iroddl == 1)
THEN
473 fskyi2(1,nn) = fx(jj)
474 fskyi2(2,nn) = fy(jj)
475 fskyi2(3,nn) = fz(jj)
477 fskyi2(5,nn) = abs(stf*h(jj,k))
478 . +stifm(k)*stf*sign(one,abs(h(jj,k)))
479 IF (iroddl == 1)
THEN
496 . irect(1,l),nir ,fsav ,fncont ,fncontp,
497 . ftcontp ,weight ,h3d_data,i ,hl)
510 IF (weight(-i) == 1)
THEN
519 IF (iroddl == 1)
THEN
533 IF (iroddl == 1)
THEN
547 IF (iroddl == 1)
THEN
561 IF (iroddl == 1)
THEN
572 IF(idtmins==2.OR.idtmins_int/=0)
THEN
574 CALL i2sms25(llt ,ix1 ,ix2 ,ix3 ,ix4 ,
575 2 nsvg ,h ,stif ,noint ,
576 3 dmint2(1,kk),nodnx_sms ,vis
587 econt = econt + econtt
588 econtd = econtd + econvt
589 fsav(26) = fsav(26) + econtt
590 fsav(28) = fsav(28) + econvt
591#include "lockoff.inc"