73
74
75
78 USE output_mod
79
80
81
82#include "implicit_f.inc"
83#include "comlock.inc"
84
85
86
87#include "mvsiz_p.inc"
88
89
90
91#include "com01_c.inc"
92#include "com04_c.inc"
93#include "com06_c.inc"
94#include "com08_c.inc"
95#include "scr05_c.inc"
96#include "scr07_c.inc"
97#include "scr11_c.inc"
98#include "scr14_c.inc"
99#include "scr16_c.inc"
100#include "scr18_c.inc"
101#include "units_c.inc"
102#include "parit_c.inc"
103#include "param_c.inc"
104#include "impl1_c.inc"
105#include "sms_c.inc"
106#include "kincod_c.inc"
107
108
109
110 TYPE(OUTPUT_), INTENT(INOUT) :: OUTPUT
111 INTEGER NELTST,ITYPTST,JLT,IBCC,IBCM,IBCS,IVIS2,INACTI,IBAG,NIN,
112 . NTY ,NLN,NLG(NLN),NSV(*),
113 . ICODT(*), ITAB(*), ISKY(*), KINET(*),
114 . MFROT, IFQ, NOINT,NEWFRONT,ISECIN, NSTRF(*),
115 . IFPEN(*) ,ICONTACT(*), CAND_N(*),
116 . KINI(*),
117 . ISET, NISKYFI,IADM,INTTH,IFORM, IGAP,JTASK
118 INTEGER IX1L(MVSIZ), IX2L(MVSIZ), IX3L(), IX4L(MVSIZ),
119 . CN_LOC(MVSIZ),CE_LOC(MVSIZ),INDEX(MVSIZ),NSVG(MVSIZ),
120 . NISUB, LISUB(*), ADDSUBS(*), ADDSUBM(*), LISUBS(*),
121 . LISUBM(*),ILAGM,ICURV(3),
122 . ISKYI_SMS(*), NSMS(*), ISENSINT(*),NFT
124 . stiglo,frot_p(*), x(3,*), xa(3,*),dxanc(3,*),
125 . a(3,*), ms(*), va(3,*), fsav(*),fcont(3,*),
126 . cand_fx(*),cand_fy(*),cand_fz(*),alpha0,
127 . gap, fric,visc,viscf,vis,dt2t,stfa(*),stifn(*),
128 . fskyi(lskyi,nfskyi),fsavsub(nthvki,*), fncont(3,*),ftcont(3,*),
129 . mskyi_sms(*)
131 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
132 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
133 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
134 . lb1(mvsiz), lb2(mvsiz), lb3(mvsiz), lb4(mvsiz),
135 . lc1(mvsiz), lc2(mvsiz), lc3(mvsiz), lc4(mvsiz),
136 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz), stif(mvsiz),
137 . gapv(mvsiz),gapr(mvsiz),secfcum(7,numnod,nsect),
138 . tmp(mvsiz),stifsav(mvsiz), viscn(*),
139 . vxi(mvsiz),vyi(mvsiz),vzi(mvsiz),msi(mvsiz),
140 . x1(mvsiz),y1(mvsiz),z1(mvsiz),
141 . x2(mvsiz),y2(mvsiz),z2(mvsiz),
142 . x3(mvsiz),y3(mvsiz),z3(mvsiz),
143 . x4(mvsiz),y4(mvsiz),z4(mvsiz),
144 . xi(mvsiz),yi(mvsiz),zi(mvsiz),penis(2,*),penim(2,*),
145 . phi(mvsiz), fthe(*),ftheskyi(lskyi),temp(*), tempi(mvsiz),
146 . rstif,fsavparit(nisub+1,11,*)
148 . nod_normal(3,*), rcurvi(*), rcontact(*), acontact(*),
149 . pcontact(*),padm, anglmi(*),gap_s(*),alphak(3,*),cmaj(mvsiz)
150 double precision
151 . daanc6(3,6,*)
152 TYPE(H3D_DATABASE) :: H3D_DATA
153
154
155
156 INTEGER I,J1,IG,J,JG,IM,IS,K0,NBINTER,K1S,K,IL,IE,NN,NI,NA1,NA2,
157 . JSUB,KSUB,JJ,KK,IN,NSUB,ISIGN,IPROJ,IBID
158 INTEGER IX1G(MVSIZ), IX2G(MVSIZ), IX3G(MVSIZ), IX4G(MVSIZ)
160 . fxr(mvsiz), fyr(mvsiz), fzr(mvsiz),
161 . fxi(mvsiz), fyi(mvsiz), fzi(mvsiz), fni(mvsiz),
162 . fxt(mvsiz),fyt(mvsiz),fzt(mvsiz),
163 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
164 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
165 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
166 . n1(mvsiz), n2(mvsiz), n3(mvsiz), pene(mvsiz),
167 . vis2(mvsiz), dtmi(mvsiz), xmu(mvsiz),stif0(mvsiz),
168 . h1(mvsiz), h2(mvsiz), h3(mvsiz), h4(mvsiz),
169 . vx(mvsiz), vy(mvsiz), vz(mvsiz), vn(mvsiz),
170 . st1(mvsiz),st2(mvsiz),st3(mvsiz),st4(mvsiz),stv(mvsiz),
171 . kt(mvsiz),c(mvsiz),cf(mvsiz),
172 . ks(mvsiz),k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
173 . cs(mvsiz),c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),
174 . p1s(mvsiz),p2s(mvsiz),p3s(mvsiz),p4s(mvsiz),
175 . phi1(mvsiz),phi2(mvsiz),phi3(mvsiz),phi4(mvsiz),
176 . fsavsub1(15,nisub),masm(mvsiz)
178 . vnx, vny, vnz, aa, crit,s2,dist,rdist,
179 . v2, fm2, dt1inv, visca, fac,ff,alphi,
alpha,beta,
180 . fx, fy, fz, f2, mas2, m2sk, dtmi0,dti,ft,fn,fmax,ftn,
181 . facm1, econtt, econvt, h0, la1, la2, la3, la4,
182 . d1,d2,d3,d4,a1,a2,a3,a4,e10, h0d, s2d, sum,
183 . fsav1, fsav2, fsav3, fsav4, fsav5, fsav6, fsav7, fsav8,
184 . fsav9, fsav10, fsav11, fsav12, fsav13, fsav14, fsav15, ffo,
185 . la1d,la2d,la3d,la4d,t1,t1d,t2,t2d,ffd,visd,facd,d1d,
186 . d2d,d3d,d4d,vnxd,vnyd,vnzd,v2d,fm2d,f2d,aad,fxd,fyd,fzd,
187 . a1d,a2d,a3d,a4d,vv,ax1,ax2,ay1,ay2,az1,az2,ax,ay,az,
188 .
area,p,vv1,vv2,v21,dmu, dti2,h00 ,a0x,a0y,a0z,rx,ry,rz,
189 . anx,any,anz,aan,aax,aay,aaz ,rr,rs,aaa,stfr,visr,
190 . prec,ps,xsa,pis,pplus,cx,cy,cfi,aux,tm,ts,impx,impy,impz,bb,
191 . nn1,nn2,nn3,nn4,xn1,yn1,zn1,xn2,yn2,zn2,xn3,yn3,zn3,xn4,yn4,
192 . zn4,dtmini,bid
193
194 DOUBLE PRECISION FX6(6,MVSIZ), FY6(6,MVSIZ), FZ6(6,MVSIZ)
195
196
197 IF (iresp==1) THEN
198 prec = fiveem4
199 ELSE
200 prec = em10
201 ENDIF
202 IF(dt1>zero)THEN
203 dt1inv = one/dt1
204 ELSE
205 dt1inv =zero
206 ENDIF
207 econtt = zero
208 econvt = zero
209 DO i=1,jlt
210 stif0(i) = stif(i)
211 ix1g(i) = nlg(ix1l(i))
212 ix2g(i) = nlg(ix2l(i))
213 ix3g(i) = nlg(ix3l(i))
214 ix4g(i) = nlg(ix4l(i))
215 ENDDO
216
217
218
219
220
221
222 IF(icurv(1) == 3) THEN
223 DO i=1,jlt
224
225 bb = gapv(i)+cmaj(i)
226
227 d1 = sqrt(p1(i))
228 p1(i) =
max(zero, bb - d1)
229
230 d2 = sqrt(p2(i))
231 p2(i) =
max(zero, bb - d2)
232
233 d3 = sqrt(p3(i))
234 p3(i) =
max(zero, bb - d3)
235
236 d4 = sqrt(p4(i))
237 p4(i) =
max(zero, bb - d4)
238
239 a1 = p1(i)/
max(em20,d1)
240 a2 = p2(i)/
max(em20,d2)
241 a3 = p3(i)/
max(em20,d3)
242 a4 = p4(i)/
max(em20,d4)
243 n1(i) = a1*nx1(i) + a2*nx2(i) + a3*nx3(i) + a4*nx4(i)
244 n2(i) = a1*ny1(i) + a2*ny2(i) + a3*ny3(i) + a4*ny4(i)
245 n3(i) = a1*nz1(i) + a2*nz2(i) + a3*nz3(i) + a4*nz4(i)
246 ENDDO
247 ELSE
248 DO i=1,jlt
249
250 d1 = sqrt(p1(i))
251 p1(i) =
max(zero, gapv(i) - d1)
252
253 d2 = sqrt(p2(i))
254 p2(i) =
max(zero, gapv(i) - d2)
255
256 d3 = sqrt(p3(i))
257 p3(i) =
max(zero, gapv(i) - d3)
258
259 d4 = sqrt(p4(i))
260 p4(i) =
max(zero, gapv(i) - d4)
261
262 a1 = p1(i)/
max(em20,d1)
263 a2 = p2(i)/
max(em20,d2)
264 a3 = p3(i)/
max(em20,d3)
265 a4 = p4(i)/
max(em20,d4)
266 n1(i) = a1*nx1(i) + a2*nx2(i) + a3*nx3(i) + a4*nx4(i)
267 n2(i) = a1*ny1(i) + a2*ny2(i) + a3*ny3(i) + a4*ny4(i)
268 n3(i) = a1*nz1(i) + a2*nz2(i) + a3*nz3(i) + a4*nz4(i)
269 ENDDO
270 ENDIF
271
272 DO i=1,jlt
273 IF(ix3g(i)/=ix4g(i))THEN
274 pene(i) =
max(p1(i),p2(i),p3(i),p4(i))
275
276 la1 = one - lb1(i) - lc1(i)
277 la2 = one - lb2(i) - lc2(i)
278 la3 = one - lb3(i) - lc3(i)
279 la4 = one - lb4(i) - lc4(i)
280
281 h0 = fourth *
282 . (p1(i)*la1 + p2(i)*la2 + p3(i)*la3 + p4(i)*la4)
283 h1(i) = h0 + p1(i) * lb1(i) + p4(i) * lc4(i)
284 h2(i) = h0 + p2(i) * lb2(i) + p1(i) * lc1(i)
285 h3(i) = h0 + p3(i) * lb3(i) + p2(i) * lc2(i)
286 h4(i) = h0 + p4(i) * lb4(i) + p3(i) * lc3(i)
287
288 h00 = one/
max(em20,h1(i) + h2(i) + h3(i) + h4(i))
289 h1(i) = h1(i) * h00
290 h2(i) = h2(i) * h00
291 h3(i) = h3(i) * h00
292 h4(i) = h4(i) * h00
293
294 ELSE
295 pene(i) = p1(i)
296 n1(i) = nx1(i)
297 n2(i) = ny1(i)
298 n3(i) = nz1(i)
299 h1(i) = lb1(i)
300 h2(i) = lc1(i)
301 h3(i) = one - lb1(i) - lc1(i)
302 h4(i) = zero
303 ENDIF
304 ENDDO
305
306
307
308 IF(icurv(1)==1)THEN
309
310 na1 = icurv(2)
311 DO i=1,jlt
312 rr = 1.e30
313 a0x = xa(1,na1)
314 a0y = xa(2,na1)
315 a0z = xa(3,na1)
316
317 rx = x1(i)-a0x
318 ry = y1(i)-a0y
319 rz = z1(i)-a0z
320 rr =
min(rr , rx*rx + ry*ry + rz*rz)
321 rx = x2(i)-a0x
322 ry = y2(i)-a0y
323 rz = z2(i)-a0z
324 rr =
min(rr , rx*rx + ry*ry + rz*rz)
325 rx = x3(i)-a0x
326 ry = y3(i)-a0y
327 rz = z3(i)-a0z
328 rr =
min(rr , rx*rx + ry*ry + rz*rz)
329 IF(ix3g(i)/=ix4g(i))THEN
330 rx = x4(i)-a0x
331 ry = y4(i)-a0y
332 rz = z4(i)-a0z
333 rr =
min(rr , rx*rx + ry*ry + rz*rz)
334 ENDIF
335 rx = xi(i)-a0x
336 ry = yi(i)-a0y
337 rz = zi(i)-a0z
338 rs = sqrt(rx*rx + ry*ry + rz*rz)
339 rr = sqrt(rr)
340 IF(rs-rr+gapv(i)<0.)THEN
341 stif(i) = 0.
342 pene(i) = 0.
343 ELSEIF(rs-rr+gapv(i)<pene(i))
THEN
344 pene(i) = rs-rr+gapv(i)
345 ENDIF
346 n1(i) = -rx
347 n2(i) = -ry
348 n3(i) = -rz
349 ENDDO
350 ELSEIF(icurv(1)==2)THEN
351
352 na1 = icurv(2)
353 na2 = icurv(3)
354 DO i=1,jlt
355 rr = 1.e30
356 a0x = xa(1,na1)
357 a0y = xa(2,na1)
358 a0z = xa(3,na1)
359 anx = xa(1,na2)-a0x
360 any = xa(2,na2)-a0y
361 anz = xa(3,na2)-a0z
362 aan = 1. / (anx*anx + any*any + anz*anz)
363
364 aax = x1(i)-a0x
365 aay = y1(i)-a0y
366 aaz = z1(i)-a0z
367 aaa = (aax*anx + aay*any + aaz*anz) * aan
368 rx = aax - aaa * anx
369 ry = aay - aaa * any
370 rz = aaz - aaa * anz
371 rr =
min(rr , rx*rx + ry*ry + rz*rz)
372
373 aax = x2(i)-a0x
374 aay = y2(i)-a0y
375 aaz = z2(i)-a0z
376 aaa = (aax*anx + aay*any + aaz*anz) * aan
377 rx = aax - aaa * anx
378 ry = aay - aaa * any
379 rz = aaz - aaa * anz
380 rr =
min(rr , rx*rx + ry*ry + rz*rz)
381
382 aax = x3(i)-a0x
383 aay = y3(i)-a0y
384 aaz = z3(i)-a0z
385 aaa = (aax*anx + aay*any + aaz*anz) * aan
386 rx = aax - aaa * anx
387 ry = aay - aaa * any
388 rz = aaz - aaa * anz
389 rr =
min(rr , rx*rx + ry*ry + rz*rz)
390 IF(ix3g(i)/=ix4g(i))THEN
391
392 aax = x4(i)-a0x
393 aay = y4(i)-a0y
394 aaz = z4(i)-a0z
395 aaa = (aax*anx + aay*any + aaz*anz) * aan
396 rx = aax - aaa * anx
397 ry = aay - aaa * any
398 rz = aaz - aaa * anz
399 rr =
min(rr , rx*rx + ry*ry + rz*rz)
400 ENDIF
401 aax = xi(i)-a0x
402 aay = yi(i)-a0y
403 aaz = zi(i)-a0z
404
405 aaa = (aax*anx + aay*any + aaz*anz) * aan
406 rx = aax - aaa * anx
407 ry = aay - aaa * any
408 rz = aaz - aaa * anz
409 rs = sqrt(rx*rx + ry*ry + rz*rz)
410 rr = sqrt(rr)
411 IF(rs-rr+gapv(i)<0.)THEN
412 stif(i) = 0.
413 pene(i) = 0.
414 ELSEIF(rs-rr+gapv(i)<pene(i))
THEN
415 pene(i) = rs-rr+gapv(i)
416 n1(i) = -rx
417 n2(i) = -ry
418 n3(i) = -rz
419 ELSEIF(rs-rr-gapv(i)>0.)THEN
420 stif(i) = 0.
421 pene(i) = 0.
422 ELSEIF(rs-rr-gapv(i) < pene(i))THEN
423 xn1 = x1(i) - xi(i)
424 yn1 = y1(i) - yi(i)
425 zn1 = z1(i) - zi(i)
426 xn2 = x2(i) - xi(i)
427 yn2 = y2(i) - yi(i)
428 zn2 = z2(i) - zi(i)
429 xn3 = x3(i) - xi(i)
430 yn3 = y3(i) - yi(i)
431 zn3 = z3(i) - zi(i)
432
433 nn1 = (yn1*zn2-yn2*zn1) * rx +
434 . (zn1*xn2-zn2*xn1) * ry +
435 . (xn1*yn2-xn2*yn1) * rz
436 nn2 = (yn2*zn3-yn3*zn2) * rx +
437 . (zn2*xn3-zn3*xn2) * ry +
438 . (xn2*yn3-xn3*yn2) * rz
439 nn3 = (yn3*zn4-yn4*zn3) * rx +
440 . (zn3*xn4-zn4*xn3) * ry +
441 . (xn3*yn4-xn4*yn3) * rz
442 IF(ix3l(i)/=ix4l(i))THEN
443 xn4 = x4(i) - xi(i)
444 yn4 = y4(i) - yi(i)
445 zn4 = z4(i) - zi(i)
446 nn4 = (yn4*zn1-yn1*zn4) * rx +
447 . (zn4*xn1-zn1*xn4) * ry +
448 . (xn4*yn1-xn1*yn4) * rz
449 ELSE
450 xn4 = zero
451 yn4 = zero
452 zn4 = zero
453 nn4=zero
454 ENDIF
455 IF( nn1>=zero .AND. nn2>=zero
456 . .AND. nn3>=zero .AND. nn4>=zero) THEN
457 iproj = 1
458 ELSEIF( nn1<=zero .AND. nn2<=zero
459 . .AND. nn3<=zero .AND. nn4<=zero) THEN
460 iproj = 1
461 ELSE
462 iproj = 0
463 ENDIF
464
465 IF(iproj == 1)THEN
466 pene(i) = -rs+rr+gapv(i)
467 n1(i) = rx
468 n2(i) = ry
469 n3(i) = rz
470 ENDIF
471 ENDIF
472 ENDDO
473
474 ELSEIF(icurv(1) == 3)THEN
475 CALL i7curv(jlt ,pene ,n1 ,n2 ,
476 1 n3 ,gapv ,xa ,nod_normal,
477 2 ix1l ,ix2l ,ix3l ,ix4l ,
478 3 h1 ,h2 ,h3 ,h4 ,
479 4 x1 ,x2 ,x3 ,x4 ,y1 ,
480 5 y2 ,y3 ,y4 ,z1 ,z2 ,
481 6 z3 ,z4 ,xi ,yi ,zi )
482
483 DO i=1,jlt
484 IF(pene(i)<zero)THEN
485 stif(i) =zero
486 pene(i) =zero
487 END IF
488 END DO
489 ENDIF
490
491 DO i=1,jlt
492 s2 = one/
max(em30,sqrt(n1(i)**2 + n2(i)**2 + n3(i)**2))
493 n1(i) = n1(i)*s2
494 n2(i) = n2(i)*s2
495 n3(i) = n3(i)*s2
496 ENDDO
497
498 DO i=1,jlt
499 vx(i) = vxi(i) - h1(i)*va(1,ix1l(i)) - h2(i)*va(1,ix2l(i))
500 . - h3(i)*va(1,ix3l(i)) - h4(i)*va(1,ix4l(i))
501 vy(i) = vyi(i) - h1(i)*va(2,ix1l(i)) - h2(i)*va(2,ix2l(i))
502 . - h3(i)*va(2,ix3l(i)) - h4(i)*va(2,ix4l(i))
503 vz(i) = vzi(i) - h1(i)*va(3,ix1l(i)) - h2(i)*va(3,ix2l(i))
504 . - h3(i)*va(3,ix3l(i)) - h4(i)*va(3,ix4l(i))
505 vn(i) = n1(i)*vx(i) + n2(i)*vy(i) + n3(i)*vz(i)
506 ENDDO
507
508 DO i=1,jlt
509
510 h0 = -.25*(h1(i) - h2(i) + h3(i) - h4(i))
511 h0 =
min(h0,h2(i),h4(i))
512 h0 =
max(h0,-h1(i),-h3(i))
513 IF(ix3g(i)==ix4g(i))h0 = zero
514 h1(i) = h1(i) + h0
515 h2(i) = h2(i) - h0
516 h3(i) = h3(i) + h0
517 h4(i) = h4(i) - h0
518 ENDDO
519
520
521
522 IF(inacti==5.or.inacti==6)THEN
523
524
525
526
527
528
529
530
531
532
533
534#include "lockon.inc"
535
536 IF(igap > 0)THEN
537 DO i=1,jlt
538 is = cn_loc(i)
539 im = ce_loc(i)
540 nn = nsvg(i)
541 pplus = pene(i) + zep05*(gapv(i)-pene(i))
542 IF(nn > 0) THEN
543 IF (pplus < gap_s(is)) THEN
544 penis(2,is) =
max(penis(2,is),pplus)
545 ELSE
546 penis(2,is) =
max(penis(2,is),gap_s(is))
547 penim(2,im) =
max(penim(2,im),pplus-gap_s(is))
548 END IF
549 ELSE
550 IF (pplus <
gapfi(nin)%P(-nn))
THEN
552 ELSE
555 penim(2,im) =
max(penim(2,im),pplus-
gapfi(nin)%P(-nn))
556 END IF
557 ENDIF
558 ENDDO
559 ELSE
560 DO i=1,jlt
561 im = ce_loc(i)
562 pplus = pene(i) + zep05*(gapv(i)-pene(i))
563 penim(2,im) =
max(penim(2,im),pplus)
564 ENDDO
565 END IF
566
567
568
569
570
571
572
573
574
575
576
577
578
579#include "lockoff.inc"
580 DO i=1,jlt
581 is = cn_loc(i)
582 im = ce_loc(i)
583 nn = nsvg(i)
584 IF(nn > 0) THEN
585 pis = penis(1,is)
586 ELSE
587 pis =
penfi(nin)%P(1,-nn)
588 END IF
589 pene(i) = pene(i) - pis - penim(1,im)
590 pene(i) =
max(pene(i),zero)
591 IF (pene(i) == zero )stif(i)=zero
592 gapv(i) = gapv(i) - pis - penim(1,im)
593 END DO
594 ENDIF
595
596
597 dti = 1.e20
598
599 DO 600 i=1,jlt
600 dist=gapv(i)-pene(i)
601 rdist = half*dist /
max(em30,-vn(i))
603 600 CONTINUE
604
605
606 dtmini=ep20
607
608 IF(dti<=dtmin1(10))THEN
609 dti = 1.e20
610 DO i=1,jlt
611 dist=gapv(i)-pene(i)
612 dti2 = half*dist /
max(em30,-vn(i))
613 IF(dti2<=dtmin1(10))THEN
614#include "lockon.inc"
615 WRITE(iout,'(A,E12.4,A,I10)')
616 . ' **WARNING MINIMUM TIME STEP ',dti2,
617 . ' IN INTERFACE ',noint
618 nn = nsvg(i)
619 IF(nn>0)THEN
620 ni = itab(nn)
621 ELSE
622 ni =
itafi(nin)%P(-nn)
623 ENDIF
624#include "lockoff.inc"
625 IF(idtmin(10)==1)THEN
626#include "lockon.inc"
627 WRITE(iout,'(A,I10)') ' secondary node : ',NI
628 WRITE(IOUT,'(a,4i10)
')' main nodes :
',
629 . ITAB(IX1G(I)),ITAB(IX2G(I)),ITAB(IX3G(I)),ITAB(IX4G(I))
630#include "lockoff.inc"
631 TSTOP = TT
632 ELSEIF(IDTMIN(10)==2)THEN
633#include "lockon.inc"
634 WRITE(IOUT,'(a,i10,a,i10)')' remove secondary node ',
635 . NI,' from INTERFACE ',NOINT
636 IF(NN>0) THEN
637 STFA(NSV(CN_LOC(I))) = -ABS(STFA(NSV(CN_LOC(I))))
638 ELSE
639 STIFI(NIN)%P(-NN) = -ABS(STIFI(NIN)%P(-NN))
640 ENDIF
641#include "lockoff.inc"
642 STIF(I) = ZERO
643 NEWFRONT = -1
644 DTI = DTMIN1(10)
645 ELSEIF(IDTMIN(10)==5)THEN
646#include "lockon.inc"
647 WRITE(IOUT,'(a,i10)') ' secondary node : ',NI
648 WRITE(IOUT,'(a,4i10)
')' main nodes :
',
649 . ITAB(IX1G(I)),ITAB(IX2G(I)),ITAB(IX3G(I)),ITAB(IX4G(I))
650#include "lockoff.inc"
651 MSTOP = 2
652.AND. ELSEIF(IDTMIN(10)==6ILAGM==2)THEN
653 IG=NSVG(I)
654 IF(KINET(IG)+KINET(IX1G(I))+KINET(IX2G(I))
655 . +KINET(IX3G(I))+KINET(IX4G(I))==0)THEN
656 CAND_N(INDEX(I)) = -IABS(CAND_N(INDEX(I)))
657 STIF(I) = ZERO
658 DTI2 = 1.E20
659#include "lockon.inc"
660 WRITE(IOUT,'(a,i10)') ' secondary node : ',ITAB(NSVG(I))
661 WRITE(IOUT,'(a,4i10)
')' main nodes :
',
662 . ITAB(IX1G(I)),ITAB(IX2G(I)),ITAB(IX3G(I)),ITAB(IX4G(I))
663#include "lockoff.inc"
664 ENDIF
665 DTI = MIN(DTI2,DTI)
666 ENDIF
667 ENDIF
668 ENDDO
669 ENDIF
670 IF(DTI<DT2T)THEN
671 DT2T = DTI
672 NELTST = NOINT
673 ITYPTST = 10
674 ENDIF
675
676 IF(IMPL_S>0)THEN
677 IF(IMP_INT7==2)THEN
678 DO I=1,JLT
679 IF(STIGLO<=ZERO)THEN
680 STIF(I) = HALF*STIF(I)
681 ELSEIF(STIF(I)/=ZERO)THEN
682 STIF(I) = STIGLO
683 ENDIF
684 FNI(I)= -STIF(I) * PENE(I)
685 ENDDO
686 ELSE
687 DO I=1,JLT
688 FAC = GAPV(I)/MAX( EM10,( GAPV(I)-PENE(I) ) )
689 FACM1 = 1./FAC
690.AND. IF( (GAPV(I)-PENE(I))/GAPV(I) <PREC
691 . STIF(I)>0. ) THEN
692 STIF(I) = 0.
693 NEWFRONT = -1
694#include "lockon.inc"
695 NN = NSVG(I)
696 IF(NN>0)THEN
697 NI = ITAB(NN)
698 STFA(NSV(CN_LOC(I))) = -ABS(STFA(NSV(CN_LOC(I))))
699 ELSE
700 NI = ITAFI(NIN)%P(-NN)
701 STIFI(NIN)%P(-NN) = -ABS(STIFI(NIN)%P(-NN))
702 ENDIF
703 WRITE(ISTDO,'(a,i10)')' warning INTERFACE ',NOINT
704 WRITE(ISTDO,'(a,i10,a)')' node ',NI,
705 . ' de-activated from interface'
706 WRITE(IOUT ,'(a,i10)')' warning INTERFACE ',NOINT
707 WRITE(IOUT ,'(a,i10,a)')' node ',NI,
708 . ' de-activated from interface'
709#include "lockoff.inc"
710 ENDIF
711 IF(STIGLO<=ZERO)THEN
712 ECONTT = ECONTT + HALF*STIF(I)*GAPV(I)**2 *( FACM1 -
713 . ONE -LOG(FACM1) )
714 STIF(I) = HALF*STIF(I) * FAC
715 ELSEIF(STIF(I)/=ZERO)THEN
716 ECONTT = ECONTT + STIGLO*GAPV(I)**2 *( FACM1 - ONE -
717 . LOG(FACM1) )
718 STIF(I) = STIGLO * FAC
719 ENDIF
720 FNI(I)= -STIF(I) * PENE(I)
721 ENDDO
722 ENDIF
723 ELSE ! fin impl_s>0
724 DO 100 I=1,JLT
725 FAC = GAPV(I)/MAX( EM10,( GAPV(I)-PENE(I) ) )
726 FACM1 = 1./FAC
727.AND. IF( (GAPV(I)-PENE(I))/GAPV(I) <PREC
728 . STIF(I)>0. ) THEN
729 STIF(I) = 0.
730 NEWFRONT = -1
731#include "lockon.inc"
732 NN = NSVG(I)
733 IF(NN>0)THEN
734 NI = ITAB(NN)
735 STFA(NSV(CN_LOC(I))) = -ABS(STFA(NSV(CN_LOC(I))))
736 ELSE
737 NI = ITAFI(NIN)%P(-NN)
738 STIFI(NIN)%P(-NN) = -ABS(STIFI(NIN)%P(-NN))
739 ENDIF
740 WRITE(ISTDO,'(a,i10)')' warning INTERFACE ',NOINT
741 WRITE(ISTDO,'(a,i10,a)')' node ',NI,
742 . ' de-activated from interface'
743 WRITE(IOUT ,'(a,i10)')' warning INTERFACE ',NOINT
744 WRITE(IOUT ,'(a,i10,a)')' node ',NI,
745 . ' de-activated from interface'
746#include "lockoff.inc"
747 ENDIF
748 IF(STIGLO<=ZERO)THEN
749 ECONTT = ECONTT + HALF*STIF(I)*GAPV(I)**2 *( FACM1 - ONE -
750 . LOG(FACM1) )
751 STIF(I) = HALF*STIF(I) * FAC
752 ELSEIF(STIF(I)/=ZERO)THEN
753 ECONTT = ECONTT + STIGLO*GAPV(I)**2 *(FACM1 - ONE - LOG(FACM1))
754 STIF(I) = STIGLO * FAC
755 ENDIF
756 FNI(I)= -STIF(I) * PENE(I)
757 100 CONTINUE
758 ENDIF
759
760
761
762.OR. IF(VISC/=ZEROVISCF/=ZERO)THEN
763 IF(IVIS2==0)THEN
764
765
766
767 DO I=1,JLT
768 VIS2(I) = TWO * STIF(I) * MSI(I)
769 IF(VN(I)<ZERO) VIS2(I) = VIS2(I) /
770 . ( MAX(EM10,(GAPV(I)-PENE(I))/GAPV(I)) )
771 ENDDO
772
773 VISCA = ZEP4
774.AND. IF(KDTINT==0IDTMINS/=2)THEN
775 DO I=1,JLT
776 FAC = STIF(I) / MAX(EM30,STIF(I))
777 VIS = SQRT(VIS2(I))
778 FF = FAC * (
779 . VISC * VIS +
780 . VISCA**2 * TWO* MSI(I) * MAX(ZERO,-VN(I)) /
781 . MAX((GAPV(I) - PENE(I)),EM10) )
782 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I) - PENE(I)),EM10)
783 STIF(I) = STIF(I) + FF * DT1INV
784 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCF)*VIS*DT1INV)
785 FFO = FF
786 FF = FF * VN(I)
787 FNI(I) = FNI(I) + FF
788 ENDDO
789 ELSE
790 DO I=1,JLT
791 FAC = STIF(I) / MAX(EM30,STIF(I))
792 VIS = SQRT(VIS2(I))
793 C(I)= FAC * (
794 . VISC * VIS +
795 . VISCA**2 * TWO * MSI(I) * MAX(ZERO,-VN(I)) /
796 . MAX((GAPV(I) - PENE(I)),EM10) )
797 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I) - PENE(I)),EM10)
798 KT(I)= STIF(I)
799 STIF(I) = STIF(I) + C(I) * DT1INV
800 FF = C(I) * VN(I)
801 FNI(I) = FNI(I) + FF
802 CF(I) = FAC*SQRT(VISCF)*VIS
803 STIF(I) = MAX(STIF(I) ,CF(I)*DT1INV)
804 ENDDO
805 ENDIF
806 ELSEIF(IVIS2==1)THEN
807
808
809
810 DO I=1,JLT
811 MASM(I) = MS(IX1G(I))*H1(I)
812 . + MS(IX2G(I))*H2(I)
813 . + MS(IX3G(I))*H3(I)
814 . + MS(IX4G(I))*H4(I)
815 MASM(I) = MSI(I) * MASM(I) / MAX(EM30,MSI(I)+MASM(I))
816 VIS2(I) = TWO * STIF(I) * MASM(I)
817 IF(VN(I)<ZERO) VIS2(I) = VIS2(I) /
818 . ( MAX(EM10,(GAPV(I)-PENE(I))/GAPV(I)) )
819 ENDDO
820
821 VISCA = ZEP4
822.AND. IF(KDTINT==0IDTMINS/=2)THEN
823 DO I=1,JLT
824 FAC = STIF(I) / MAX(EM30,STIF(I))
825 VIS = SQRT(VIS2(I))
826 FF = FAC * (
827 . VISC * VIS +
828 . VISCA**2 * TWO* MASM(I) * MAX(ZERO,-VN(I)) /
829 . MAX((GAPV(I) - PENE(I)),EM10) )
830 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I) - PENE(I)),EM10)
831 STIF(I) = STIF(I) + FF * DT1INV
832 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCF)*VIS*DT1INV)
833 FFO = FF
834 FF = FF * VN(I)
835 FNI(I) = FNI(I) + FF
836 ENDDO
837 ELSE
838 DO I=1,JLT
839 FAC = STIF(I) / MAX(EM30,STIF(I))
840 VIS = SQRT(VIS2(I))
841 C(I)= FAC * (
842 . VISC * VIS +
843 . VISCA**2 * TWO * MASM(I) * MAX(ZERO,-VN(I)) /
844 . MAX((GAPV(I) - PENE(I)),EM10) )
845 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I) - PENE(I)),EM10)
846 KT(I)= STIF(I)
847 STIF(I) = STIF(I) + C(I) * DT1INV
848 FF = C(I) * VN(I)
849 FNI(I) = FNI(I) + FF
850 CF(I) = FAC*SQRT(VISCF)*VIS
851 STIF(I) = MAX(STIF(I) ,CF(I)*DT1INV)
852 ENDDO
853 ENDIF
854 ELSEIF(IVIS2==2)THEN
855
856
857
858 DO I=1,JLT
859 VIS2(I) = TWO* STIF(I) * MSI(I)
860 VIS2(I) = VIS2(I) /
861 . ( MAX(EM10,(GAPV(I)-PENE(I))/GAPV(I)) )
862 ENDDO
863 VISCA = HALF
864 DO I=1,JLT
865 FAC = STIF(I) / MAX(EM30,STIF(I))
866 VIS = SQRT(VIS2(I))
867 FF = FAC * (
868 . VISC * VIS +
869 . VISCA**2 * TWO * MSI(I) * ABS(VN(I)) /
870 . MAX((GAPV(I) - PENE(I)),EM10) )
871 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I) - PENE(I)),EM10)
872 STIF(I) = STIF(I) + TWO * FF * DT1INV
873 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCF)*VIS*DT1INV)
874 FF = FF * VN(I)
875 FNI(I) = FNI(I) + FF
876 ENDDO
877 ELSEIF(IVIS2==3)THEN
878
879
880
881 DO I=1,JLT
882 VIS2(I) = TWO * STIF(I) * MSI(I)
883 ENDDO
884
885 DO I=1,JLT
886 FAC = STIF(I) / MAX(EM30,STIF(I))
887 VIS = SQRT(VIS2(I))
888 FF = FAC * ( VISC * VIS ) /
889 . MAX((GAPV(I) - PENE(I)),EM10)
890 STIF(I) = STIF(I) * GAPV(I) /
891 . MAX((GAPV(I) - PENE(I)),EM10)
892 STIF(I) = STIF(I) + TWO* FF * DT1INV
893 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCF)*VIS*DT1INV)
894 FF = FF * VN(I)
895 FNI(I) = FNI(I) + FF
896 ENDDO
897 ELSEIF(IVIS2==4)THEN
898
899
900
901 DO I=1,JLT
902 VIS2(I) = TWO* STIF(I) * MSI(I)
903 VIS = SQRT(VIS2(I))
904 STIF(I) = STIF(I) * GAPV(I) /
905 . MAX((GAPV(I) - PENE(I)),EM10)
906 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCF)*VIS*DT1INV)
907 ENDDO
908 ELSEIF(IVIS2==5)THEN
909
910
911
912
913
914 DO I=1,JLT
915 MAS2 = MS(IX1G(I))*H1(I)
916 . + MS(IX2G(I))*H2(I)
917 . + MS(IX3G(I))*H3(I)
918 . + MS(IX4G(I))*H4(I)
919 VIS2(I) = TWO* STIF(I) * MSI(I)
920 VIS = 2. * VISC * DT1INV * MSI(I) * MAS2 /
921 . MAX(EM30,MSI(I)+MAS2)
922 STIF(I) = STIF(I) * GAPV(I) /
923 . MAX((GAPV(I) - PENE(I)),EM10)
924 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCF*VIS2(I))*DT1INV)
925 FF = VIS * VN(I)
926 ECONVT = ECONVT + MIN(ZERO,FF-FNI(I)) * VN(I) * DT1
927 FNI(I) = MIN(FNI(I),FF)
928 ENDDO
929 ELSE
930 ENDIF
931 ELSE
932 DO I=1,JLT
933 VIS2(I) = ZERO
934 STIF(I) = STIF(I) * GAPV(I) /
935 . MAX((GAPV(I) - PENE(I)),EM10)
936 ENDDO
937 ENDIF
938
939
940
941#include "lockon.inc"
942 DO I=1,JLT
943 ISIGN=1
944 AAA = ONE-PENE(I)/GAPV(I)
945 IL = IX1L(I)
946.OR. IF(PENE(I)>ZEROALPHAK(2,IL)<ZERO)ISIGN=-1
947 ALPHAK(2,IL)=ISIGN*MIN(ABS(ALPHAK(2,IL)),AAA)
948 IL = IX2L(I)
949.OR. IF(PENE(I)>ZEROALPHAK(2,IL)<ZERO)ISIGN=-1
950 ALPHAK(2,IL)=ISIGN*MIN(ABS(ALPHAK(2,IL)),AAA)
951 IL = IX3L(I)
952.OR. IF(PENE(I)>ZEROALPHAK(2,IL)<ZERO)ISIGN=-1
953 ALPHAK(2,IL)=ISIGN*MIN(ABS(ALPHAK(2,IL)),AAA)
954 IL = IX4L(I)
955.OR. IF(PENE(I)>ZEROALPHAK(2,IL)<ZERO)ISIGN=-1
956 ALPHAK(2,IL)=ISIGN*MIN(ABS(ALPHAK(2,IL)),AAA)
957 IF(NSVG(I)>0) THEN
958 IL = NSV(CN_LOC(I))
959.OR. IF(PENE(I)>ZEROALPHAK(2,IL)<ZERO)ISIGN=-1
960 ALPHAK(2,IL)=ISIGN*MIN(ABS(ALPHAK(2,IL)),AAA)
961 ELSE
962
963 IL = - NSVG(I)
964.OR. IF(PENE(I)>ZEROALPHAKFI(NIN)%P(IL)<ZERO)ISIGN=-1
965 ALPHAKFI(NIN)%P(IL)=ISIGN*MIN(ABS(ALPHAKFI(NIN)%P(IL)),AAA)
966 ENDIF
967 ENDDO
968#include "lockoff.inc"
969
970
971
972 FSAV1 = ZERO
973 FSAV2 = ZERO
974 FSAV3 = ZERO
975
976 FSAV8 = ZERO
977 FSAV9 = ZERO
978 FSAV10= ZERO
979 FSAV11= ZERO
980 DO I=1,JLT
981 FXI(I)=N1(I)*FNI(I)
982 FYI(I)=N2(I)*FNI(I)
983 FZI(I)=N3(I)*FNI(I)
984 IMPX=FXI(I)*DT12
985 IMPY=FYI(I)*DT12
986 IMPZ=FZI(I)*DT12
987 FSAV1 =FSAV1 +IMPX
988 FSAV2 =FSAV2 +IMPY
989 FSAV3 =FSAV3 +IMPZ
990 FSAV8 =FSAV8 +ABS(IMPX)
991 FSAV9 =FSAV9 +ABS(IMPY)
992 FSAV10=FSAV10+ABS(IMPZ)
993 FSAV11=FSAV11+FNI(I)*DT12
994 ENDDO
995#include "lockon.inc"
996 FSAV(1)=FSAV(1)+FSAV1
997 FSAV(2)=FSAV(2)+FSAV2
998 FSAV(3)=FSAV(3)+FSAV3
999
1000 FSAV(8)=FSAV(8)+FSAV8
1001 FSAV(9)=FSAV(9)+FSAV9
1002 FSAV(10)=FSAV(10)+FSAV10
1003 FSAV(11)=FSAV(11)+FSAV11
1004#include "lockoff.inc"
1005
1006 IF(ISENSINT(1)/=0) THEN
1007 DO I=1,JLT
1008 FSAVPARIT(1,1,I+NFT) = FXI(I)
1009 FSAVPARIT(1,2,I+NFT) = FYI(I)
1010 FSAVPARIT(1,3,I+NFT) = FZI(I)
1011 ENDDO
1012 ENDIF
1013
1014.AND. IF((ANIM_V(12)+OUTP_V(12)+H3D_DATA%N_VECT_PCONT >0
1015.AND..OR..OR..AND..OR. . ((TT>=OUTPUT%TANIM TT<=OUTPUT%TANIM_STOP)TT>=TOUTP(TT>=H3D_DATA%TH3DTT<=H3D_DATA%TH3D_STOP)
1016.AND..OR. . (MANIM>=4MANIM<=15)H3D_DATA%MH3D/=0))
1017.OR. . H3D_DATA%N_VECT_PCONT_MAX>0)THEN
1018#include "lockon.inc"
1019 DO I=1,JLT
1020 FNCONT(1,IX1G(I)) =FNCONT(1,IX1G(I)) + FXI(I)*H1(I)
1021 FNCONT(2,IX1G(I)) =FNCONT(2,IX1G(I)) + FYI(I)*H1(I)
1022 FNCONT(3,IX1G(I)) =FNCONT(3,IX1G(I)) + FZI(I)*H1(I)
1023 FNCONT(1,IX2G(I)) =FNCONT(1,IX2G(I)) + FXI(I)*H2(I)
1024 FNCONT(2,IX2G(I)) =FNCONT(2,IX2G(I)) + FYI(I)*H2(I)
1025 FNCONT(3,IX2G(I)) =FNCONT(3,IX2G(I)) + FZI(I)*H2(I)
1026 FNCONT(1,IX3G(I)) =FNCONT(1,IX3G(I)) + FXI(I)*H3(I)
1027 FNCONT(2,IX3G(I)) =FNCONT(2,IX3G(I)) + FYI(I)*H3(I)
1028 FNCONT(3,IX3G(I)) =FNCONT(3,IX3G(I)) + FZI(I)*H3(I)
1029 FNCONT(1,IX4G(I)) =FNCONT(1,IX4G(I)) + FXI(I)*H4(I)
1030 FNCONT(2,IX4G(I)) =FNCONT(2,IX4G(I)) + FYI(I)*H4(I)
1031 FNCONT(3,IX4G(I)) =FNCONT(3,IX4G(I)) + FZI(I)*H4(I)
1032 JG = NSVG(I)
1033 IF(JG>0) THEN
1034
1035 FNCONT(1,JG)=FNCONT(1,JG)- FXI(I)
1036 FNCONT(2,JG)=FNCONT(2,JG)- FYI(I)
1037 FNCONT(3,JG)=FNCONT(3,JG)- FZI(I)
1038 ELSE ! cas noeud remote en SPMD
1039 JG = -JG
1040 FNCONTI(NIN)%P(1,JG)=FNCONTI(NIN)%P(1,JG)-FXI(I)
1041 FNCONTI(NIN)%P(2,JG)=FNCONTI(NIN)%P(2,JG)-FYI(I)
1042 FNCONTI(NIN)%P(3,JG)=FNCONTI(NIN)%P(3,JG)-FZI(I)
1043 ENDIF
1044 ENDDO
1045#include "lockoff.inc"
1046 ENDIF
1047
1048
1049
1050 IF(NISUB/=0)THEN
1051 DO JSUB=1,NISUB
1052 DO J=1,15
1053 FSAVSUB1(J,JSUB)=ZERO
1054 END DO
1055 ENDDO
1056 DO I=1,JLT
1057 NN = NSVG(I)
1058 IF(NN>0)THEN
1059 IN=CN_LOC(I)
1060 IE=CE_LOC(I)
1061 JJ =ADDSUBS(IN)
1062 KK =ADDSUBM(IE)
1063 DO WHILE(JJ<ADDSUBS(IN+1))
1064 JSUB=LISUBS(JJ)
1065 DO WHILE(KK<ADDSUBM(IE+1))
1066 KSUB=LISUBM(KK)
1067 IF(KSUB==JSUB)THEN
1068 IMPX=FXI(I)*DT12
1069 IMPY=FYI(I)*DT12
1070 IMPZ=FZI(I)*DT12
1071
1072 FSAVSUB1(1,JSUB)=FSAVSUB1(1,JSUB)+IMPX
1073 FSAVSUB1(2,JSUB)=FSAVSUB1(2,JSUB)+IMPY
1074 FSAVSUB1(3,JSUB)=FSAVSUB1(3,JSUB)+IMPZ
1075
1076 FSAVSUB1(8,JSUB) =FSAVSUB1(8,JSUB) +ABS(IMPX)
1077 FSAVSUB1(9,JSUB) =FSAVSUB1(9,JSUB) +ABS(IMPY)
1078 FSAVSUB1(10,JSUB)=FSAVSUB1(10,JSUB)+ABS(IMPZ)
1079
1080 FSAVSUB1(11,JSUB)=FSAVSUB1(11,JSUB)+FNI(I)*DT12
1081 KK=KK+1
1082 GO TO 250
1083 ELSE IF(KSUB<JSUB)THEN
1084 KK=KK+1
1085 ELSE
1086 GO TO 250
1087 END IF
1088 END DO
1089 250 CONTINUE
1090 JJ=JJ+1
1091 END DO
1092 END IF
1093 END DO
1094
1095 IF(NSPMD>1) THEN
1096
1097 DO I=1,JLT
1098 NN = NSVG(I)
1099 IF(NN<0)THEN
1100 NN = -NN
1101 IE=CE_LOC(I)
1102 JJ =ADDSUBSFI(NIN)%P(NN)
1103 KK =ADDSUBM(IE)
1104 DO WHILE(JJ<ADDSUBSFI(NIN)%P(NN+1))
1105 JSUB=LISUBSFI(NIN)%P(JJ)
1106 DO WHILE(KK<ADDSUBM(IE+1))
1107 KSUB=LISUBM(KK)
1108 IF(KSUB==JSUB)THEN
1109 IMPX=FXI(I)*DT12
1110 IMPY=FYI(I)*DT12
1111 IMPZ=FZI(I)*DT12
1112
1113 FSAVSUB1(1,JSUB)=FSAVSUB1(1,JSUB)+IMPX
1114 FSAVSUB1(2,JSUB)=FSAVSUB1(2,JSUB)+IMPY
1115 FSAVSUB1(3,JSUB)=FSAVSUB1(3,JSUB)+IMPZ
1116
1117 FSAVSUB1(8,JSUB) =FSAVSUB1(8,JSUB) +ABS(IMPX)
1118 FSAVSUB1(9,JSUB) =FSAVSUB1(9,JSUB) +ABS(IMPY)
1119 FSAVSUB1(10,JSUB)=FSAVSUB1(10,JSUB)+ABS(IMPZ)
1120
1121 FSAVSUB1(11,JSUB)=FSAVSUB1(11,JSUB)+FNI(I)*DT12
1122 KK=KK+1
1123 GO TO 150
1124 ELSE IF(KSUB<JSUB)THEN
1125 KK=KK+1
1126 ELSE
1127 GO TO 150
1128 END IF
1129 END DO
1130 150 CONTINUE
1131 JJ=JJ+1
1132 END DO
1133 END IF
1134
1135 END DO
1136
1137 END IF
1138 END IF
1139
1140
1141
1142
1143 IF (MFROT==0) THEN
1144
1145 DO I=1,JLT
1146 XMU(I) = FRIC
1147 ENDDO
1148 ELSEIF (MFROT==1) THEN
1149
1150 DO I=1,JLT
1151 AA = N1(I)*VX(I) + N2(I)*VY(I) + N3(I)*VZ(I)
1152 V2 = (VX(I) - N1(I)*AA)**2
1153 . + (VY(I) - N2(I)*AA)**2
1154 . + (VZ(I) - N3(I)*AA)**2
1155 VV = SQRT(MAX(EM30,V2))
1156 AX1 = X3(I) - X1(I)
1157 AY1 = Y3(I) - Y1(I)
1158 AZ1 = Z3(I) - Z1(I)
1159 AX2 = X4(I) - X2(I)
1160 AY2 = Y4(I) - Y2(I)
1161 AZ2 = Z4(I) - Z2(I)
1162 AX = AY1*AZ2 - AZ1*AY2
1163 AY = AZ1*AX2 - AX1*AZ2
1164 AZ = AX1*AY2 - AY1*AX2
1165 AREA = HALF*SQRT(AX*AX+AY*AY+AZ*AZ)
1166 P = -FNI(I)/AREA
1167 XMU(I) = FRIC + (FROT_P(1) + FROT_P(4)*P ) * P
1168 . +(FROT_P(2) + FROT_P(3)*P) * VV + FROT_P(5)*V2
1169 ENDDO
1170 ELSEIF(MFROT==2)THEN
1171
1172 DO I=1,JLT
1173 AA = N1(I)*VX(I) + N2(I)*VY(I) + N3(I)*VZ(I)
1174 V2 = (VX(I) - N1(I)*AA)**2
1175 . + (VY(I) - N2(I)*AA)**2
1176 . + (VZ(I) - N3(I)*AA)**2
1177 VV = SQRT(MAX(EM30,V2))
1178 AX1 = X3(I) - X1(I)
1179 AY1 = Y3(I) - Y1(I)
1180 AZ1 = Z3(I) - Z1(I)
1181 AX2 = X4(I) - X2(I)
1182 AY2 = Y4(I) - Y2(I)
1183 AZ2 = Z4(I) - Z2(I)
1184 AX = AY1*AZ2 - AZ1*AY2
1185 AY = AZ1*AX2 - AX1*AZ2
1186 AZ = AX1*AY2 - AY1*AX2
1187 AREA = HALF*SQRT(AX*AX+AY*AY+AZ*AZ)
1188 P = -FNI(I)/AREA
1189 XMU(I) = FRIC
1190 . + FROT_P(1)*EXP(FROT_P(2)*VV)*P*P
1191 . + FROT_P(3)*EXP(FROT_P(4)*VV)*P
1192 . + FROT_P(5)*EXP(FROT_P(6)*VV)
1193 ENDDO
1194 ELSEIF (MFROT==3) THEN
1195
1196 DO I=1,JLT
1197 AA = N1(I)*VX(I) + N2(I)*VY(I) + N3(I)*VZ(I)
1198 V2 = (VX(I) - N1(I)*AA)**2
1199 . + (VY(I) - N2(I)*AA)**2
1200 . + (VZ(I) - N3(I)*AA)**2
1201 VV = SQRT(MAX(EM30,V2))
1202.AND. IF(VV>=0VV<=FROT_P(5)) THEN
1203 DMU = FROT_P(3)-FROT_P(1)
1204 VV1 = VV / FROT_P(5)
1205 XMU(I) = FROT_P(1)+ DMU*VV1*(TWO-VV1)
1206.AND. ELSEIF(VV>FROT_P(5)VV<FROT_P(6)) THEN
1207 DMU = FROT_P(4)-FROT_P(3)
1208 VV1 = (VV - FROT_P(5))/(FROT_P(6)-FROT_P(5))
1209 XMU(I) = FROT_P(3)+ DMU * (THREE-TWO*VV1)*VV1**2
1210 ELSE
1211 DMU = FROT_P(2)-FROT_P(4)
1212 VV2 = (VV - FROT_P(6))**2
1213 XMU(I) = FROT_P(2) - DMU / (ONE + DMU*VV2)
1214 ENDIF
1215 ENDDO
1216 ELSEIF(MFROT==4)THEN
1217
1218 DO I=1,JLT
1219 AA = N1(I)*VX(I) + N2(I)*VY(I) + N3(I)*VZ(I)
1220 V2 = (VX(I) - N1(I)*AA)**2
1221 . + (VY(I) - N2(I)*AA)**2
1222 . + (VZ(I) - N3(I)*AA)**2
1223 VV = SQRT(MAX(EM30,V2))
1224 XMU(I) = FROT_P(1)
1225 . + (FRIC-FROT_P(1))*EXP(-FROT_P(2)*VV)
1226 XMU(I) = MAX(XMU(I),EM30)
1227 ENDDO
1228 ENDIF
1229
1230
1231
1232 FSAV4 = ZERO
1233 FSAV5 = ZERO
1234 FSAV6 = ZERO
1235
1236 FSAV12= ZERO
1237 FSAV13= ZERO
1238 FSAV14= ZERO
1239 FSAV15= ZERO
1240
1241 IF (IFQ>=10) THEN
1242
1243
1244
1245 IF (IFQ==13) THEN
1246 ALPHA = MAX(ONE,ALPHA0*DT12)
1247 ELSE
1248 ALPHA = ALPHA0
1249 ENDIF
1250 DO I=1,JLT
1251 FX = STIF0(I)*VX(I)*DT12
1252 FY = STIF0(I)*VY(I)*DT12
1253 FZ = STIF0(I)*VZ(I)*DT12
1254
1255 FX = CAND_FX(INDEX(I)) + ALPHA*FX
1256 FY = CAND_FY(INDEX(I)) + ALPHA*FY
1257 FZ = CAND_FZ(INDEX(I)) + ALPHA*FZ
1258
1259 FTN = FX*N1(I) + FY*N2(I) + FZ*N3(I)
1260 FX = FX - FTN*N1(I)
1261 FY = FY - FTN*N2(I)
1262 FZ = FZ - FTN*N3(I)
1263 FT = FX*FX + FY*FY + FZ*FZ
1264 FT = MAX(FT,EM30)
1265
1266 FN = FXI(I)**2+FYI(I)**2+FZI(I)**2
1267
1268 BETA = MIN(ONE,XMU(I)*SQRT(FN/FT))
1269
1270 FXT(I) = FX * BETA
1271 FYT(I) = FY * BETA
1272 FZT(I) = FZ * BETA
1273
1274 CAND_FX(INDEX(I)) = FXT(I)
1275 CAND_FY(INDEX(I)) = FYT(I)
1276 CAND_FZ(INDEX(I)) = FZT(I)
1277 IFPEN(INDEX(I)) = 1
1278
1279
1280 FXI(I)=FXI(I) + FXT(I)
1281 FYI(I)=FYI(I) + FYT(I)
1282 FZI(I)=FZI(I) + FZT(I)
1283 ECONVT = ECONVT
1284 . + DT1*(VX(I)*FXT(I)+VY(I)*FYT(I)+VZ(I)*FZT(I))
1285 ENDDO
1286
1287
1288
1289 ELSEIF (IFQ>0) THEN
1290
1291 IF (IFQ==3) THEN
1292 ALPHA = MAX(ONE,ALPHA0*DT12)
1293 ELSE
1294 ALPHA = ALPHA0
1295 ENDIF
1296 ALPHI = ONE - ALPHA
1297 DO I=1,JLT
1298 VNX = N1(I)*VN(I)
1299 VNY = N2(I)*VN(I)
1300 VNZ = N3(I)*VN(I)
1301 VX(I) = VX(I) - VNX
1302 VY(I) = VY(I) - VNY
1303 VZ(I) = VZ(I) - VNZ
1304 V2 = VX(I)**2 + VY(I)**2 + VZ(I)**2
1305 VIS2(I) = VISCF * VIS2(I)
1306 FM2 = (XMU(I)*FNI(I))**2
1307 F2 = VIS2(I) * V2
1308 A2 = MIN(F2,FM2) / MAX(EM30,F2)
1309 AA = SQRT(A2 * VIS2(I))
1310 FX = AA * VX(I)
1311 FY = AA * VY(I)
1312 FZ = AA * VZ(I)
1313
1314 FXT(I) = ALPHA*FX + ALPHI*CAND_FX(INDEX(I))
1315 FYT(I) = ALPHA*FY + ALPHI*CAND_FY(INDEX(I))
1316 FZT(I) = ALPHA*FZ + ALPHI*CAND_FZ(INDEX(I))
1317 CAND_FX(INDEX(I)) = FXT(I)
1318 CAND_FY(INDEX(I)) = FYT(I)
1319 CAND_FZ(INDEX(I)) = FZT(I)
1320 IFPEN(INDEX(I)) = 1
1321
1322 FXI(I) = FXI(I) + FXT(I)
1323 FYI(I) = FYI(I) + FYT(I)
1324 FZI(I) = FZI(I) + FZT(I)
1325 ECONVT = ECONVT
1326 . + DT1*(VX(I)*FXT(I)+VY(I)*FYT(I)+VZ(I)*FZT(I))
1327 ENDDO
1328 ELSE
1329
1330
1331
1332 DO I=1,JLT
1333 VNX = N1(I)*VN(I)
1334 VNY = N2(I)*VN(I)
1335 VNZ = N3(I)*VN(I)
1336 VX(I) = VX(I) - VNX
1337 VY(I) = VY(I) - VNY
1338 VZ(I) = VZ(I) - VNZ
1339 V2 = VX(I)**2 + VY(I)**2 + VZ(I)**2
1340 VIS2(I) = VISCF * VIS2(I)
1341 FM2 = (XMU(I)*FNI(I))**2
1342 F2 = VIS2(I) * V2
1343 A2 = MIN(F2,FM2) / MAX(EM30,F2)
1344 AA = SQRT(A2 * VIS2(I))
1345 FXT(I) = AA * VX(I)
1346 FYT(I) = AA * VY(I)
1347 FZT(I) = AA * VZ(I)
1348
1349 FXI(I)=FXI(I) + FXT(I)
1350 FYI(I)=FYI(I) + FYT(I)
1351 FZI(I)=FZI(I) + FZT(I)
1352 ECONVT = ECONVT + AA * V2 * DT1
1353 ENDDO
1354 ENDIF
1355
1356.AND. IF((ANIM_V(12)+OUTP_V(12)+H3D_DATA%N_VECT_PCONT>0
1357.AND..OR..OR..AND..OR. . ((TT>=OUTPUT%TANIM TT<=OUTPUT%TANIM_STOP)TT>=TOUTP(TT>=H3D_DATA%TH3DTT<=H3D_DATA%TH3D_STOP)
1358.AND..OR. . (MANIM>=4MANIM<=15)H3D_DATA%MH3D/=0))
1359.OR. . H3D_DATA%N_VECT_PCONT_MAX>0)THEN
1360#include "lockon.inc"
1361 DO I=1,JLT
1362 FTCONT(1,IX1G(I)) =FTCONT(1,IX1G(I)) + FXT(I)*H1(I)
1363 FTCONT(2,IX1G(I)) =FTCONT(2,IX1G(I)) + FYT(I)*H1(I)
1364 FTCONT(3,IX1G(I)) =FTCONT(3,IX1G(I)) + FZT(I)*H1(I)
1365 FTCONT(1,IX2G(I)) =FTCONT(1,IX2G(I)) + FXT(I)*H2(I)
1366 FTCONT(2,IX2G(I)) =FTCONT(2,IX2G(I)) + FYT(I)*H2(I)
1367 FTCONT(3,IX2G(I)) =FTCONT(3,IX2G(I)) + FZT(I)*H2(I)
1368 FTCONT(1,IX3G(I)) =FTCONT(1,IX3G(I)) + FXT(I)*H3(I)
1369 FTCONT(2,IX3G(I)) =FTCONT(2,IX3G(I)) + FYT(I)*H3(I)
1370 FTCONT(3,IX3G(I)) =FTCONT(3,IX3G(I)) + FZT(I)*H3(I)
1371 FTCONT(1,IX4G(I)) =FTCONT(1,IX4G(I)) + FXT(I)*H4(I)
1372 FTCONT(2,IX4G(I)) =FTCONT(2,IX4G(I)) + FYT(I)*H4(I)
1373 FTCONT(3,IX4G(I)) =FTCONT(3,IX4G(I)) + FZT(I)*H4(I)
1374 JG = NSVG(I)
1375 IF(JG>0) THEN
1376
1377 FTCONT(1,JG)=FTCONT(1,JG)- FXT(I)
1378 FTCONT(2,JG)=FTCONT(2,JG)- FYT(I)
1379 FTCONT(3,JG)=FTCONT(3,JG)- FZT(I)
1380 ELSE ! cas noeud remote en SPMD
1381 JG = -JG
1382 FTCONTI(NIN)%P(1,JG)=FTCONTI(NIN)%P(1,JG)-FXT(I)
1383 FTCONTI(NIN)%P(2,JG)=FTCONTI(NIN)%P(2,JG)-FYT(I)
1384 FTCONTI(NIN)%P(3,JG)=FTCONTI(NIN)%P(3,JG)-FZT(I)
1385 ENDIF
1386 ENDDO
1387#include "lockoff.inc"
1388 ENDIF
1389
1390
1391 DO I=1,JLT
1392 IMPX=FXT(I)*DT12
1393 IMPY=FYT(I)*DT12
1394 IMPZ=FZT(I)*DT12
1395 FSAV4 =FSAV4 +IMPX
1396 FSAV5 =FSAV5 +IMPY
1397 FSAV6 =FSAV6 +IMPZ
1398 IMPX=FXI(I)*DT12
1399 IMPY=FYI(I)*DT12
1400 IMPZ=FZI(I)*DT12
1401 FSAV12=FSAV12+ABS(IMPX)
1402 FSAV13=FSAV13+ABS(IMPY)
1403 FSAV14=FSAV14+ABS(IMPZ)
1404 FSAV15=FSAV15+SQRT(IMPX*IMPX+IMPY*IMPY+IMPZ*IMPZ)
1405 ENDDO
1406#include "lockon.inc"
1407 FSAV(4) = FSAV(4) + FSAV4
1408 FSAV(5) = FSAV(5) + FSAV5
1409 FSAV(6) = FSAV(6) + FSAV6
1410
1411 FSAV(12) = FSAV(12) + FSAV12
1412 FSAV(13) = FSAV(13) + FSAV13
1413 FSAV(14) = FSAV(14) + FSAV14
1414 FSAV(15) = FSAV(15) + FSAV15
1415#include "lockoff.inc"
1416
1417 IF(ISENSINT(1)/=0) THEN
1418 DO I=1,JLT
1419 FSAVPARIT(1,4,I+NFT) = FXT(I)
1420 FSAVPARIT(1,5,I+NFT) = FYT(I)
1421 FSAVPARIT(1,6,I+NFT) = FZT(I)
1422 ENDDO
1423 ENDIF
1424
1425
1426
1427
1428 IF(NISUB/=0)THEN
1429 DO I=1,JLT
1430 NN = NSVG(I)
1431 IF(NN>0)THEN
1432 IN=CN_LOC(I)
1433 IE=CE_LOC(I)
1434 JJ =ADDSUBS(IN)
1435 KK =ADDSUBM(IE)
1436 DO WHILE(JJ<ADDSUBS(IN+1))
1437 JSUB=LISUBS(JJ)
1438 DO WHILE(KK<ADDSUBM(IE+1))
1439 KSUB=LISUBM(KK)
1440 IF(KSUB==JSUB)THEN
1441 IMPX=FXT(I)*DT12
1442 IMPY=FYT(I)*DT12
1443 IMPZ=FZT(I)*DT12
1444
1445 FSAVSUB1(4,JSUB)=FSAVSUB1(4,JSUB)+IMPX
1446 FSAVSUB1(5,JSUB)=FSAVSUB1(5,JSUB)+IMPY
1447 FSAVSUB1(6,JSUB)=FSAVSUB1(6,JSUB)+IMPZ
1448
1449 IMPX=FXI(I)*DT12
1450 IMPY=FYI(I)*DT12
1451 IMPZ=FZI(I)*DT12
1452 FSAVSUB1(12,JSUB)=FSAVSUB1(12,JSUB)+ABS(IMPX)
1453 FSAVSUB1(13,JSUB)=FSAVSUB1(13,JSUB)+ABS(IMPY)
1454 FSAVSUB1(14,JSUB)=FSAVSUB1(14,JSUB)+ABS(IMPZ)
1455
1456 FSAVSUB1(15,JSUB)= FSAVSUB1(15,JSUB)
1457 . +SQRT(IMPX*IMPX+IMPY*IMPY+IMPZ*IMPZ)
1458 KK=KK+1
1459 GO TO 200
1460 ELSE IF(KSUB<JSUB)THEN
1461 KK=KK+1
1462 ELSE
1463 GO TO 200
1464 END IF
1465 END DO
1466 200 CONTINUE
1467 JJ=JJ+1
1468 END DO
1469 END IF
1470 END DO
1471
1472 IF(NSPMD>1) THEN
1473
1474 DO I=1,JLT
1475 NN = NSVG(I)
1476 IF(NN<0)THEN
1477
1478 NN = -NN
1479 IE=CE_LOC(I)
1480 JJ =ADDSUBSFI(NIN)%P(NN)
1481 KK =ADDSUBM(IE)
1482 DO WHILE(JJ<ADDSUBSFI(NIN)%P(NN+1))
1483 JSUB=LISUBSFI(NIN)%P(JJ)
1484 DO WHILE(KK<ADDSUBM(IE+1))
1485 KSUB=LISUBM(KK)
1486 IF(KSUB==JSUB)THEN
1487 IMPX=FXT(I)*DT12
1488 IMPY=FYT(I)*DT12
1489 IMPZ=FZT(I)*DT12
1490
1491 FSAVSUB1(4,JSUB)=FSAVSUB1(4,JSUB)+IMPX
1492 FSAVSUB1(5,JSUB)=FSAVSUB1(5,JSUB)+IMPY
1493 FSAVSUB1(6,JSUB)=FSAVSUB1(6,JSUB)+IMPZ
1494
1495 IMPX=FXI(I)*DT12
1496 IMPY=FYI(I)*DT12
1497 IMPZ=FZI(I)*DT12
1498 FSAVSUB1(12,JSUB)=FSAVSUB1(12,JSUB)+ABS(IMPX)
1499 FSAVSUB1(13,JSUB)=FSAVSUB1(13,JSUB)+ABS(IMPY)
1500 FSAVSUB1(14,JSUB)=FSAVSUB1(14,JSUB)+ABS(IMPZ)
1501
1502 FSAVSUB1(15,JSUB)= FSAVSUB1(15,JSUB)
1503 . +SQRT(IMPX*IMPX+IMPY*IMPY+IMPZ*IMPZ)
1504 KK=KK+1
1505 GO TO 300
1506 ELSE IF(KSUB<JSUB)THEN
1507 KK=KK+1
1508 ELSE
1509 GO TO 300
1510 END IF
1511 END DO
1512 300 CONTINUE
1513 JJ=JJ+1
1514 END DO
1515 END IF
1516
1517 END DO
1518
1519 END IF
1520#include "lockon.inc"
1521 DO JSUB=1,NISUB
1522 NSUB=LISUB(JSUB)
1523 DO J=1,15
1524 FSAVSUB(J,NSUB)=FSAVSUB(J,NSUB)+FSAVSUB1(J,JSUB)
1525 END DO
1526 END DO
1527#include "lockoff.inc"
1528 END IF
1529
1530#include "lockon.inc"
1531 ECONTV = ECONTV + ECONVT
1532 ECONT = ECONT + ECONTT
1533#include "lockoff.inc"
1534
1535 IF(KDTINT==1)THEN
1536.OR. IF( (VISC/=ZEROVISCF/=ZERO)
1537.AND..OR. . (IVIS2==0IVIS2==1))THEN
1538 DO I=1,JLT
1539
1540 IF(MSI(I)==ZERO)THEN
1541 KS(I) =ZERO
1542 CS(I) =ZERO
1543 STV(I)=ZERO
1544 ELSE
1545 CX = FOUR*C(I)*C(I)
1546 CY = EIGHT*MSI(I)*KT(I)
1547 AUX = SQRT(CX+CY)+TWO*C(I)
1548 STV(I)= KT(I)*AUX*AUX/MAX(CY,EM30)
1549 AUX = TWO*CF(I)*CF(I)/MAX(MSI(I),EM20)
1550 IF(AUX>STV(I))THEN
1551 KS(I) =ZERO
1552 CS(I) =CF(I)
1553 STV(I)=AUX
1554 ELSE
1555 KS(I)= KT(I)
1556 CS(I) =C(I)
1557 ENDIF
1558 ENDIF
1559
1560 J1=IX1G(I)
1561 IF(MS(J1)==ZERO)THEN
1562 K1(I) =ZERO
1563 C1(I) =ZERO
1564 ST1(I)=ZERO
1565 ELSE
1566 K1(I)=KT(I)*ABS(H1(I))
1567 C1(I)=C(I)*ABS(H1(I))
1568 CX =FOUR*C1(I)*C1(I)
1569 CY =EIGHT*MS(J1)*K1(I)
1570 AUX = SQRT(CX+CY)+TWO*C1(I)
1571 ST1(I)= K1(I)*AUX*AUX/MAX(CY,EM30)
1572 CFI = CF(I)*ABS(H1(I))
1573 AUX = TWO*CFI*CFI/MAX(MS(J1),EM20)
1574 IF(AUX>ST1(I))THEN
1575 K1(I) =ZERO
1576 C1(I) =CFI
1577 ST1(I)=AUX
1578 ENDIF
1579 ENDIF
1580
1581 J1=IX2G(I)
1582 IF(MS(J1)==ZERO)THEN
1583 K2(I) =ZERO
1584 C2(I) =ZERO
1585 ST2(I)=ZERO
1586 ELSE
1587 K2(I)=KT(I)*ABS(H2(I))
1588 C2(I)=C(I)*ABS(H2(I))
1589 CX =FOUR*C2(I)*C2(I)
1590 CY =EIGHT*MS(J1)*K2(I)
1591 AUX = SQRT(CX+CY)+TWO*C2(I)
1592 ST2(I)= K2(I)*AUX*AUX/MAX(CY,EM30)
1593 CFI = CF(I)*ABS(H2(I))
1594 AUX = TWO*CFI*CFI/MAX(MS(J1),EM20)
1595 IF(AUX>ST2(I))THEN
1596 K2(I) =ZERO
1597 C2(I) =CFI
1598 ST2(I)=AUX
1599 ENDIF
1600 ENDIF
1601
1602 J1=IX3G(I)
1603 IF(MS(J1)==ZERO)THEN
1604 K3(I) =ZERO
1605 C3(I) =ZERO
1606 ST3(I)=ZERO
1607 ELSE
1608 K3(I)=KT(I)*ABS(H3(I))
1609 C3(I)=C(I)*ABS(H3(I))
1610 CX =FOUR*C3(I)*C3(I)
1611 CY =EIGHT*MS(J1)*K3(I)
1612 AUX = SQRT(CX+CY)+TWO*C3(I)
1613 ST3(I)= K3(I)*AUX*AUX/MAX(CY,EM30)
1614 CFI = CF(I)*ABS(H3(I))
1615 AUX = TWO*CFI*CFI/MAX(MS(J1),EM20)
1616 IF(AUX>ST3(I))THEN
1617 K3(I) =ZERO
1618 C3(I) =CFI
1619 ST3(I)=AUX
1620 ENDIF
1621 ENDIF
1622
1623 J1=IX4G(I)
1624 IF(MS(J1)==ZERO)THEN
1625 K4(I) =ZERO
1626 C4(I) =ZERO
1627 ST4(I)=ZERO
1628 ELSE
1629 K4(I)=KT(I)*ABS(H4(I))
1630 C4(I)=C(I)*ABS(H4(I))
1631 CX =FOUR*C4(I)*C4(I)
1632 CY =EIGHT*MS(J1)*K4(I)
1633 AUX = SQRT(CX+CY)+TWO*C4(I)
1634 ST4(I)= K4(I)*AUX*AUX/MAX(CY,EM30)
1635 CFI = CF(I)*ABS(H4(I))
1636 AUX = TWO*CFI*CFI/MAX(MS(J1),EM20)
1637 IF(AUX>ST4(I))THEN
1638 K4(I) =ZERO
1639 C4(I) =CFI
1640 ST4(I)=AUX
1641 ENDIF
1642 ENDIF
1643 ENDDO
1644
1645 ELSE
1646 DO I=1,JLT
1647 KS(I) =STIF(I)
1648 CS(I) =ZERO
1649 STV(I)=KS(I)
1650 K1(I) =STIF(I)*ABS(H1(I))
1651 C1(I) =ZERO
1652 ST1(I)=K1(I)
1653 K2(I) =STIF(I)*ABS(H2(I))
1654 C2(I) =ZERO
1655 ST2(I)=K2(I)
1656 K3(I) =STIF(I)*ABS(H3(I))
1657 C3(I) =ZERO
1658 ST3(I)=K3(I)
1659 K4(I) =STIF(I)*ABS(H4(I))
1660 C4(I) =ZERO
1661 ST4(I)=K4(I)
1662 ENDDO
1663 ENDIF
1664 ENDIF
1665
1666.OR..OR. IF(IDTMIN(10)==1IDTMIN(10)==2
1667.OR. . IDTMIN(10)==5IDTMIN(10)==6)THEN
1668
1669 DTMI0 = EP20
1670 IF(KDTINT==0)THEN
1671 DO I=1,JLT
1672 DTMI(I) = EP20
1673 MAS2 = TWO * MSI(I)
1674.AND..AND. IF(MAS2>ZEROSTIF(I)>ZERO
1675.AND. . IRB(KINI(I))==0IRB2(KINI(I))==0)THEN
1676 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/STIF(I)))
1677 ENDIF
1678 MAS2 = TWO* MS(IX1G(I))
1679.AND..AND. IF(MAS2>ZEROH1(I)*STIF(I)>ZERO
1680.AND. . IRB(KINET(IX1G(I)))==0IRB2(KINET(IX1G(I)))==0)THEN
1681 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/(H1(I)*STIF(I))))
1682 ENDIF
1683 MAS2 = TWO * MS(IX2G(I))
1684.AND..AND. IF(MAS2>ZEROH2(I)*STIF(I)>ZERO
1685.AND. . IRB(KINET(IX2G(I)))==0IRB2(KINET(IX2G(I)))==0)THEN
1686 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/(H2(I)*STIF(I))))
1687 ENDIF
1688 MAS2 = TWO* MS(IX3G(I))
1689.AND..AND. IF(MAS2>ZEROH3(I)*STIF(I)>ZERO
1690.AND. . IRB(KINET(IX3G(I)))==0IRB2(KINET(IX3G(I)))==0)THEN
1691 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/(H3(I)*STIF(I))))
1692 ENDIF
1693 MAS2 = TWO * MS(IX4G(I))
1694.AND..AND. IF(MAS2>ZEROH4(I)*STIF(I)>ZERO
1695.AND. . IRB(KINET(IX4G(I)))==0IRB2(KINET(IX4G(I)))==0)THEN
1696 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/(H4(I)*STIF(I))))
1697 ENDIF
1698 DTMI0 = MIN(DTMI0,DTMI(I))
1699 ENDDO
1700
1701 ELSE
1702 DO I=1,JLT
1703 DTMI(I) = EP20
1704 MAS2 = TWO * MSI(I)
1705 MAS2 = TWO * MSI(I)
1706.AND..AND. IF(MAS2>ZEROSTV(I)>ZERO
1707.AND. . IRB(KINI(I))==0IRB2(KINI(I))==0)THEN
1708 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/STV(I)))
1709 ENDIF
1710 MAS2 = TWO * MS(IX1G(I))
1711.AND..AND. IF(MAS2>ZEROST1(I)>ZERO
1712.AND. . IRB(KINET(IX1G(I)))==0IRB2(KINET(IX1G(I)))==0)THEN
1713 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/(ST1(I))))
1714 ENDIF
1715 MAS2 = TWO * MS(IX2G(I))
1716.AND..AND. IF(MAS2>ZEROST2(I)>ZERO
1717.AND. . IRB(KINET(IX2G(I)))==0IRB2(KINET(IX2G(I)))==0)THEN
1718 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/(ST2(I))))
1719 ENDIF
1720 MAS2 = TWO * MS(IX3G(I))
1721.AND..AND. IF(MAS2>ZEROST3(I)>ZERO
1722.AND. . IRB(KINET(IX3G(I)))==0IRB2(KINET(IX3G(I)))==0)THEN
1723 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/(ST3(I))))
1724 ENDIF
1725 MAS2 = TWO * MS(IX4G(I))
1726.AND..AND. IF(MAS2>ZEROST4(I)>ZERO
1727.AND. . IRB(KINET(IX4G(I)))==0IRB2(KINET(IX4G(I)))==0)THEN
1728 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/(ST4(I))))
1729 ENDIF
1730 DTMI0 = MIN(DTMI0,DTMI(I))
1731 ENDDO
1732 ENDIF
1733 IF(DTMI0<=DTMIN1(10))THEN
1734 DO I=1,JLT
1735 IF(DTMI(I)<=DTMIN1(10))THEN
1736 JG = NSVG(I)
1737 IF(JG>0)THEN
1738 NI = ITAB(JG)
1739 ELSE
1740 NI = ITAFI(NIN)%P(-JG)
1741 ENDIF
1742 IF(IDTMIN(10)==1)THEN
1743#include "lockon.inc"
1744 WRITE(IOUT,'(a,e12.4,a,i10)')
1745 . ' **warning minimum time step ',DTMI(I),
1746 . ' in INTERFACE ',NOINT
1747 WRITE(IOUT,'(a,i10)') ' secondary node : ',NI
1748 WRITE(IOUT,'(a,4i10)
')' main nodes :
',
1749 . ITAB(IX1G(I)),ITAB(IX2G(I)),ITAB(IX3G(I)),ITAB(IX4G(I))
1750#include "lockoff.inc"
1751 TSTOP = TT
1752 ELSEIF(IDTMIN(10)==2)THEN
1753#include "lockon.inc"
1754 WRITE(IOUT,'(a,e12.4,a,i10)')
1755 . ' **warning minimum time step ',DTMI(I),
1756 . ' in INTERFACE ',NOINT
1757 WRITE(IOUT,'(a,i10,a,i10)')' delete secondary node ',
1758 . NI,' from INTERFACE ',NOINT
1759 WRITE(IOUT,'(a,4i10)
')' main nodes :
',
1760 . ITAB(IX1G(I)),ITAB(IX2G(I)),ITAB(IX3G(I)),ITAB(IX4G(I))
1761 IF(JG>0) THEN
1762 STFA(NSV(CN_LOC(I))) = -ABS(STFA(NSV(CN_LOC(I))))
1763 ELSE
1764 STIFI(NIN)%P(-JG) = -ABS(STIFI(NIN)%P(-JG))
1765 ENDIF
1766#include "lockoff.inc"
1767 NEWFRONT = -1
1768 ELSEIF(IDTMIN(10)==5)THEN
1769#include "lockon.inc"
1770 WRITE(IOUT,'(a,e12.4,a,i10)')
1771 . ' **warning minimum time step ',DTMI(I),
1772 . ' in INTERFACE ',NOINT
1773 WRITE(IOUT,'(a,i10)') ' secondary node : ',NI
1774 WRITE(IOUT,'(a,4i10)
')' main nodes :
',
1775 . ITAB(IX1G(I)),ITAB(IX2G(I)),ITAB(IX3G(I)),ITAB(IX4G(I))
1776#include "lockoff.inc"
1777 MSTOP = 2
1778.AND. ELSEIF(IDTMIN(10)==6ILAGM==2)THEN
1779 IF(KINET(JG)+KINET(IX1G(I))+KINET(IX2G(I))
1780 . +KINET(IX3G(I))+KINET(IX4G(I))==0 )THEN
1781 CAND_N(INDEX(I)) = -IABS(CAND_N(INDEX(I)))
1782 STIF(I) = 0.
1783 FXI(I) = 0.
1784 FYI(I) = 0.
1785 FZI(I) = 0.
1786 ENDIF
1787 ENDIF
1788 ENDIF
1789 ENDDO
1790 ENDIF
1791 ENDIF
1792
1793
1794
1795 DO I=1,JLT
1796 FX1(I)=FXI(I)*H1(I)
1797 FY1(I)=FYI(I)*H1(I)
1798 FZ1(I)=FZI(I)*H1(I)
1799
1800 FX2(I)=FXI(I)*H2(I)
1801 FY2(I)=FYI(I)*H2(I)
1802 FZ2(I)=FZI(I)*H2(I)
1803
1804 FX3(I)=FXI(I)*H3(I)
1805 FY3(I)=FYI(I)*H3(I)
1806 FZ3(I)=FZI(I)*H3(I)
1807
1808 FX4(I)=FXI(I)*H4(I)
1809 FY4(I)=FYI(I)*H4(I)
1810 FZ4(I)=FZI(I)*H4(I)
1811 ENDDO
1812
1813
1814
1815
1816 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FXI, FX6)
1817 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FYI, FY6)
1818 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FZI, FZ6)
1819#include "lockon.inc"
1820
1821 DO I = 1,JLT
1822 IG = NSVG(I)
1823 IF(IG > 0)THEN
1824 IL = NSV(CN_LOC(I))
1825 DO K = 1,6
1826 DAANC6(1,K,IL) = DAANC6(1,K,IL) - FX6(K,I)
1827 DAANC6(2,K,IL) = DAANC6(2,K,IL) - FY6(K,I)
1828 DAANC6(3,K,IL) = DAANC6(3,K,IL) - FZ6(K,I)
1829 ENDDO
1830 ELSE
1831
1832
1833
1834 IL = - IG
1835 DO K = 1,6
1836 DAANC6FI(NIN)%P(1,K,IL) = DAANC6FI(NIN)%P(1,K,IL) - FX6(K,I)
1837 DAANC6FI(NIN)%P(2,K,IL) = DAANC6FI(NIN)%P(2,K,IL) - FY6(K,I)
1838 DAANC6FI(NIN)%P(3,K,IL) = DAANC6FI(NIN)%P(3,K,IL) - FZ6(K,I)
1839 ENDDO
1840 ENDIF
1841 ENDDO
1842
1843
1844
1845 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FX1, FX6)
1846 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FY1, FY6)
1847 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FZ1, FZ6)
1848 DO I = 1,JLT
1849 IL = IX1L(I)
1850 DO K = 1,6
1851 DAANC6(1,K,IL) = DAANC6(1,K,IL) + FX6(K,I)
1852 DAANC6(2,K,IL) = DAANC6(2,K,IL) + FY6(K,I)
1853 DAANC6(3,K,IL) = DAANC6(3,K,IL) + FZ6(K,I)
1854 ENDDO
1855 ENDDO
1856
1857 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FX2, FX6)
1858 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FY2, FY6)
1859 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FZ2, FZ6)
1860 DO I = 1,JLT
1861 IL = IX2L(I)
1862 DO K = 1,6
1863 DAANC6(1,K,IL) = DAANC6(1,K,IL) + FX6(K,I)
1864 DAANC6(2,K,IL) = DAANC6(2,K,IL) + FY6(K,I)
1865 DAANC6(3,K,IL) = DAANC6(3,K,IL) + FZ6(K,I)
1866 ENDDO
1867 ENDDO
1868
1869 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FX3, FX6)
1870 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FY3, FY6)
1871 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FZ3, FZ6)
1872 DO I = 1,JLT
1873 IL = IX3L(I)
1874 DO K = 1,6
1875 DAANC6(1,K,IL) = DAANC6(1,K,IL) + FX6(K,I)
1876 DAANC6(2,K,IL) = DAANC6(2,K,IL) + FY6(K,I)
1877 DAANC6(3,K,IL) = DAANC6(3,K,IL) + FZ6(K,I)
1878 ENDDO
1879 ENDDO
1880
1881 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FX4, FX6)
1882 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FY4, FY6)
1883 CALL FOAT_TO_6_FLOAT(1 ,JLT ,FZ4, FZ6)
1884 DO I = 1,JLT
1885 IL = IX4L(I)
1886 DO K = 1,6
1887 DAANC6(1,K,IL) = DAANC6(1,K,IL) + FX6(K,I)
1888 DAANC6(2,K,IL) = DAANC6(2,K,IL) + FY6(K,I)
1889 DAANC6(3,K,IL) = DAANC6(3,K,IL) + FZ6(K,I)
1890 ENDDO
1891 ENDDO
1892#include "lockoff.inc"
1893
1894
1895
1896
1897
1898 DO I = 1,JLT
1899 IF(GAPV(I) > GAPR(I))THEN
1900 IG = NSVG(I)
1901 IF(IG > 0)THEN
1902 IL = NSV(CN_LOC(I))
1903 XSA = N1(I)*(DXANC(1,IL)-H1(I)*DXANC(1,IX1L(I))
1904 . -H2(I)*DXANC(1,IX2L(I))
1905 . -H3(I)*DXANC(1,IX3L(I))
1906 . -H4(I)*DXANC(1,IX4L(I)))
1907 . + N2(I)*(DXANC(2,IL)-H1(I)*DXANC(2,IX1L(I))
1908 . -H2(I)*DXANC(2,IX2L(I))
1909 . -H3(I)*DXANC(2,IX3L(I))
1910 . -H4(I)*DXANC(2,IX4L(I)))
1911 . + N3(I)*(DXANC(3,IL)-H1(I)*DXANC(3,IX1L(I))
1912 . -H2(I)*DXANC(3,IX2L(I))
1913 . -H3(I)*DXANC(3,IX3L(I))
1914 . -H4(I)*DXANC(3,IX4L(I)))
1915 ELSE
1916
1917
1918
1919
1920
1921 IL = - IG
1922 XSA = N1(I)*(DXANCFI(NIN)%P(1,IL)-H1(I)*DXANC(1,IX1L(I))
1923 . -H2(I)*DXANC(1,IX2L(I))
1924 . -H3(I)*DXANC(1,IX3L(I))
1925 . -H4(I)*DXANC(1,IX4L(I)))
1926 . + N2(I)*(DXANCFI(NIN)%P(2,IL)-H1(I)*DXANC(2,IX1L(I))
1927 . -H2(I)*DXANC(2,IX2L(I))
1928 . -H3(I)*DXANC(2,IX3L(I))
1929 . -H4(I)*DXANC(2,IX4L(I)))
1930 . + N3(I)*(DXANCFI(NIN)%P(3,IL)-H1(I)*DXANC(3,IX1L(I))
1931 . -H2(I)*DXANC(3,IX2L(I))
1932 . -H3(I)*DXANC(3,IX3L(I))
1933 . -H4(I)*DXANC(3,IX4L(I)))
1934 END IF
1935 PS = PENE(I) - XSA - GAPV(I) + GAPR(I)
1936 IF(PS <= ZERO)THEN
1937 STIF(I) = ZERO
1938 FXI(I) = ZERO
1939 FYI(I) = ZERO
1940 FZI(I) = ZERO
1941 FX1(I) = ZERO
1942 FY1(I) = ZERO
1943 FZ1(I) = ZERO
1944 FX2(I) = ZERO
1945 FY2(I) = ZERO
1946 FZ2(I) = ZERO
1947 FX3(I) = ZERO
1948 FY3(I) = ZERO
1949 FZ3(I) = ZERO
1950 FX4(I) = ZERO
1951 FY4(I) = ZERO
1952 FZ4(I) = ZERO
1953 IF (IFQ>0) THEN
1954 CAND_FX(INDEX(I)) = ZERO
1955 CAND_FY(INDEX(I)) = ZERO
1956 CAND_FZ(INDEX(I)) = ZERO
1957
1958 ENDIF
1959 ENDIF
1960 ENDIF
1961 ENDDO
1962
1963
1964
1965
1966.OR. IF(INTTH == 0 IFORM == 0) THEN
1967 DO I=1,JLT
1968 PHI1(I) = ZERO
1969 PHI2(I) = ZERO
1970 PHI3(I) = ZERO
1971 PHI4(I) = ZERO
1972
1973 ENDDO
1974 ELSEIF(IFORM > 0) THEN
1975 DO I=1,JLT
1976 TM = H1(I)*TEMP(IX1G(I)) + H2(I)*TEMP(IX2G(I))
1977 . + H3(I)*TEMP(IX3G(I)) + H4(I)*TEMP(IX4G(I))
1978
1979 TS = TEMPI(I)
1980
1981 AX1 = XA(1,IX3L(I)) - XA(1,IX1L(I))
1982 AY1 = XA(2,IX3L(I)) - XA(2,IX1L(I))
1983 AZ1 = XA(3,IX3L(I)) - XA(3,IX1L(I))
1984 AX2 = XA(1,IX4L(I)) - XA(1,IX2L(I))
1985 AY2 = XA(2,IX4L(I)) - XA(2,IX2L(I))
1986 AZ2 = XA(3,IX4L(I)) - XA(3,IX2L(I))
1987
1988 AX = AY1*AZ2 - AZ1*AY2
1989 AY = AZ1*AX2 - AX1*AZ2
1990 AZ = AX1*AY2 - AY1*AX2
1991
1992 AREA = ONE_OVER_8*SQRT(AX*AX+AY*AY+AZ*AZ)
1993 PHI(I) = AREA* (TM - TS)*DT1 / RSTIF
1994 PHI1(I) = -PHI(I) *H1(I)
1995 PHI2(I) = -PHI(I) *H2(I)
1996 PHI3(I) = -PHI(I) *H3(I)
1997 PHI4(I) = -PHI(I) *H4(I)
1998 ENDDO
1999 ENDIF
2000
2001 IF (NSPMD>1) THEN
2002
2003#include "mic_lockon.inc"
2004 DO I = 1,JLT
2005 NN = NSVG(I)
2006 IF(NN<0)THEN
2007
2008 NSVFI(NIN)%P(-NN) = -ABS(NSVFI(NIN)%P(-NN))
2009 ENDIF
2010 ENDDO
2011
2012#include "mic_lockoff.inc"
2013 ENDIF
2014
2015.OR. IF(IDTMINS==2IDTMINS_INT/=0)THEN
2016 DTI=DT2T
2017 CALL I7SMS2(JLT ,IX1G ,IX2G ,IX3G ,IX4G ,
2018 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
2019 3 NIN ,NOINT ,MSKYI_SMS, ISKYI_SMS,NSMS ,
2020 4 KT ,C ,CF ,DTMINI,DTI )
2021 IF(DTI<DT2T)THEN
2022 DT2T = DTI
2023 NELTST = NOINT
2024 ITYPTST = 10
2025 ENDIF
2026 ENDIF
2027
2028 IF(IDTMINS_INT/=0)THEN
2029 STIF(1:JLT)=ZERO
2030 END IF
2031
2032 BID = ZERO
2033 IBID =0
2034 IF(IPARIT==3)THEN
2035 IF(KDTINT==0)THEN
2036 CALL I7ASS3(JLT ,IX1G ,IX2G ,IX3G ,IX4G ,
2037 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
2038 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
2039 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
2040 5 FXI ,FYI ,FZI ,A ,STIFN)
2041 ELSE
2042 CALL I7ASS35(JLT ,IX1G ,IX2G ,IX3G ,IX4G ,
2043 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
2044 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
2045 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
2046 5 FXI ,FYI ,FZI ,A ,STIFN,VISCN,
2047 6 KS ,K1 ,K2 ,K3 ,K4 ,CS ,
2048 7 C1 ,C2 ,C3 ,C4 )
2049 ENDIF
2050 ELSEIF(IPARIT==0)THEN
2051 IF(KDTINT==0)THEN
2052 CALL I7ASS0(JLT ,IX1G ,IX2G ,IX3G ,IX4G ,
2053 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
2054 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
2055 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
2056 5 FXI ,FYI ,FZI ,A ,STIFN ,NIN ,
2057 6 INTTH ,PHI ,FTHE ,PHI1 , PHI2 ,PHI3 ,
2058 7 PHI4 ,BID ,BID ,JTASK,IBID ,IBID )
2059
2060 ELSE
2061
2062 CALL I7ASS05(JLT ,IX1G ,IX2G ,IX3G ,IX4G ,
2063 2 NSVG ,H1 ,H2 ,H3 ,H4 ,
2064 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
2065 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
2066 5 FXI ,FYI ,FZI ,A ,STIFN ,VISCN ,
2067 6 KS ,K1 ,K2 ,K3 ,K4 ,CS ,
2068 7 C1 ,C2 ,C3 ,C4 ,NIN ,INTTH ,
2069 8 PHI ,FTHE ,PHI1 , PHI2 ,PHI3 , PHI4,JTASK,
2070 9 BID ,BID ,IBID ,IBID )
2071 ENDIF
2072
2073 ELSE
2074 IF(KDTINT==0)THEN
2075 CALL I7ASS2(JLT ,IX1G ,IX2G ,IX3G ,IX4G ,
2076 2 NSVG ,H1 ,H2 ,H3 ,H4 ,STIF ,
2077 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
2078 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
2079 5 FXI ,FYI ,FZI ,FSKYI,ISKY ,NISKYFI,
2080 6 NIN ,NOINT ,INTTH,PHI ,FTHESKYI,PHI1,
2081 7 PHI2 ,PHI3 , PHI4,BID ,BID ,
2082 A IBID ,IBID )
2083 ELSE
2084 CALL I7ASS25(JLT ,IX1G ,IX2G ,IX3G ,IX4G ,
2085 2 NSVG ,H1 ,H2 ,H3 ,H4 ,
2086 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,FZ2 ,
2087 4 FX3 ,FY3 ,FZ3 ,FX4 ,FY4 ,FZ4 ,
2088 5 FXI ,FYI ,FZI ,FSKYI,NISKYFI,NIN ,
2089 6 KS ,K1 ,K2 ,K3 ,K4 ,CS ,
2090 7 C1 ,C2 ,C3 ,C4 ,ISKY ,NOINT ,
2091 8 INTTH ,PHI ,FTHESKYI,PHI1,PHI2 ,PHI3,
2092 9 PHI4 ,BID ,BID ,IBID ,IBID )
2093 ENDIF
2094 ENDIF
2095
2096 IF(ANIM_V(4)+OUTP_V(4)+H3D_DATA%N_VECT_CONT>0)THEN
2097#include "lockon.inc"
2098
2099 DO I=1,JLT
2100 FCONT(1,IX1G(I)) =FCONT(1,IX1G(I)) + FX1(I)
2101 FCONT(2,IX1G(I)) =FCONT(2,IX1G(I)) + FY1(I)
2102 FCONT(3,IX1G(I)) =FCONT(3,IX1G(I)) + FZ1(I)
2103 FCONT(1,IX2G(I)) =FCONT(1,IX2G(I)) + FX2(I)
2104 FCONT(2,IX2G(I)) =FCONT(2,IX2G(I)) + FY2(I)
2105 FCONT(3,IX2G(I)) =FCONT(3,IX2G(I)) + FZ2(I)
2106 FCONT(1,IX3G(I)) =FCONT(1,IX3G(I)) + FX3(I)
2107 FCONT(2,IX3G(I)) =FCONT(2,IX3G(I)) + FY3(I)
2108 FCONT(3,IX3G(I)) =FCONT(3,IX3G(I)) + FZ3(I)
2109 FCONT(1,IX4G(I)) =FCONT(1,IX4G(I)) + FX4(I)
2110 FCONT(2,IX4G(I)) =FCONT(2,IX4G(I)) + FY4(I)
2111 FCONT(3,IX4G(I)) =FCONT(3,IX4G(I)) + FZ4(I)
2112 JG = NSVG(I)
2113 IF(JG>0) THEN
2114
2115 FCONT(1,JG)=FCONT(1,JG)- FXI(I)
2116 FCONT(2,JG)=FCONT(2,JG)- FYI(I)
2117 FCONT(3,JG)=FCONT(3,JG)- FZI(I)
2118 ENDIF
2119 ENDDO
2120
2121#include "lockoff.inc"
2122 ENDIF
2123
2124 IF(ISECIN>0)THEN
2125 K0=NSTRF(25)
2126 IF(NSTRF(1)+NSTRF(2)/=0)THEN
2127 DO I=1,NSECT
2128 NBINTER=NSTRF(K0+14)
2129 K1S=K0+30
2130 DO J=1,NBINTER
2131 IF(NSTRF(K1S)==NOINT)THEN
2132 IF(ISECUT/=0)THEN
2133#include "lockon.inc"
2134 DO K=1,JLT
2135
2136
2137 IF(SECFCUM(4,IX1G(K),I)==1.)THEN
2138 SECFCUM(1,IX1G(K),I)=SECFCUM(1,IX1G(K),I)-FX1(K)
2139 SECFCUM(2,IX1G(K),I)=SECFCUM(2,IX1G(K),I)-FY1(K)
2140 SECFCUM(3,IX1G(K),I)=SECFCUM(3,IX1G(K),I)-FZ1(K)
2141 ENDIF
2142 IF(SECFCUM(4,IX2G(K),I)==1.)THEN
2143 SECFCUM(1,IX2G(K),I)=SECFCUM(1,IX2G(K),I)-FX2(K)
2144 SECFCUM(2,IX2G(K),I)=SECFCUM(2,IX2G(K),I)-FY2(K)
2145 SECFCUM(3,IX2G(K),I)=SECFCUM(3,IX2G(K),I)-FZ2(K)
2146 ENDIF
2147 IF(SECFCUM(4,IX3G(K),I)==1.)THEN
2148 SECFCUM(1,IX3G(K),I)=SECFCUM(1,IX3G(K),I)-FX3(K)
2149 SECFCUM(2,IX3G(K),I)=SECFCUM(2,IX3G(K),I)-FY3(K)
2150 SECFCUM(3,IX3G(K),I)=SECFCUM(3,IX3G(K),I)-FZ3(K)
2151 ENDIF
2152 IF(SECFCUM(4,IX4G(K),I)==1.)THEN
2153 SECFCUM(1,IX4G(K),I)=SECFCUM(1,IX4G(K),I)-FX4(K)
2154 SECFCUM(2,IX4G(K),I)=SECFCUM(2,IX4G(K),I)-FY4(K)
2155 SECFCUM(3,IX4G(K),I)=SECFCUM(3,IX4G(K),I)-FZ4(K)
2156 ENDIF
2157
2158 JG = NSVG(K)
2159 IF(JG>0) THEN
2160
2161 IF(SECFCUM(4,JG,I)==1.)THEN
2162 SECFCUM(1,JG,I)=SECFCUM(1,JG,I)+FXI(K)
2163 SECFCUM(2,JG,I)=SECFCUM(2,JG,I)+FYI(K)
2164 SECFCUM(3,JG,I)=SECFCUM(3,JG,I)+FZI(K)
2165 ENDIF
2166 ENDIF
2167
2168 ENDDO
2169#include "lockoff.inc"
2170 ENDIF
2171
2172 ENDIF
2173 K1S=K1S+1
2174 ENDDO
2175 K0=NSTRF(K0+24)
2176 ENDDO
2177 ENDIF
2178 ENDIF
2179
2180
2181.OR. IF(IBAG/=0IADM/=0)THEN
2182 DO I=1,JLT
2183
2184
2185
2186.OR..OR. IF(FXI(I)/=ZEROFYI(I)/=ZEROFZI(I)/=ZERO)THEN
2187
2188 JG = NSVG(I)
2189 IF(JG>0) THEN
2190
2191 ICONTACT(JG)=1
2192 ENDIF
2193
2194 ICONTACT(IX1G(I))=1
2195 ICONTACT(IX2G(I))=1
2196 ICONTACT(IX3G(I))=1
2197 ICONTACT(IX4G(I))=1
2198 ENDIF
2199 ENDDO
2200 ENDIF
2201
2202 IF(IADM/=0)THEN
2203 DO I=1,JLT
2204 JG = NSVG(I)
2205#include "lockon.inc"
2206 IF(JG>0) THEN
2207
2208 RCONTACT(JG)=MIN(RCONTACT(JG),RCURVI(I))
2209 END IF
2210 RCONTACT(IX1G(I))=MIN(RCONTACT(IX1G(I)),RCURVI(I))
2211 RCONTACT(IX2G(I))=MIN(RCONTACT(IX2G(I)),RCURVI(I))
2212 RCONTACT(IX3G(I))=MIN(RCONTACT(IX3G(I)),RCURVI(I))
2213 RCONTACT(IX4G(I))=MIN(RCONTACT(IX4G(I)),RCURVI(I))
2214#include "lockoff.inc"
2215 END DO
2216 END IF
2217 IF(IADM>=2)THEN
2218 DO I=1,JLT
2219 JG = NSVG(I)
2220#include "lockon.inc"
2221 IF(JG>0) THEN
2222
2223 PCONTACT(JG)=MAX(PCONTACT(JG),PENE(I)/(PADM*GAPV(I)))
2224 ACONTACT(JG)=MIN(ACONTACT(JG),ANGLMI(I))
2225 END IF
2226#include "lockoff.inc"
2227 END DO
2228 END IF
2229
2230 IF(IBCC==0) RETURN
2231
2232 DO 400 I=1,JLT
2233
2234 IF(PENE(I)==ZERO)GOTO 400
2235 IBCM = IBCC / 8
2236 IBCS = IBCC - 8 * IBCM
2237 IF(IBCS>0) THEN
2238 IG=NSVG(I)
2239 IF(IG>0) THEN
2240
2241 CALL IBCOFF(IBCS,ICODT(IG))
2242 ENDIF
2243 ENDIF
2244 IF(IBCM>0) THEN
2245 IG=IX1G(I)
2246 CALL IBCOFF(IBCM,ICODT(IG))
2247 IG=IX2G(I)
2248 CALL IBCOFF(IBCM,ICODT(IG))
2249 IG=IX3G(I)
2250 CALL IBCOFF(IBCM,ICODT(IG))
2251 IG=IX4G(I)
2252 CALL IBCOFF(IBCM,ICODT(IG))
2253 ENDIF
2254 400 CONTINUE
2255
2256 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine i7curv(jlt, pene, n1, n2, n3, gapv, x, nod_normal, ix1, ix2, ix3, ix4, h1, h2, h3, h4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi)
type(real_pointer2), dimension(:), allocatable penfi
type(real_pointer), dimension(:), allocatable gapfi
type(int_pointer), dimension(:), allocatable itafi
int main(int argc, char *argv[])
1.15.0