OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20for3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i20for3 ../engine/source/interfaces/int20/i20for3.f
25!||--- called by ------------------------------------------------------
26!|| i20mainf ../engine/source/interfaces/int20/i20mainf.f
27!||--- calls -----------------------------------------------------
28!|| foat_to_6_float ../engine/source/system/parit.F
29!|| i7ass0 ../engine/source/interfaces/int07/i7ass3.F
30!|| i7ass05 ../engine/source/interfaces/int07/i7ass3.F
31!|| i7ass2 ../engine/source/interfaces/int07/i7ass3.F
32!|| i7ass25 ../engine/source/interfaces/int07/i7ass3.F
33!|| i7ass3 ../engine/source/interfaces/int07/i7ass3.F
34!|| i7ass35 ../engine/source/interfaces/int07/i7ass3.F
35!|| i7curv ../engine/source/interfaces/int07/i7curv.F
36!|| i7sms2 ../engine/source/interfaces/int07/i7sms2.F
37!|| ibcoff ../engine/source/interfaces/interf/ibcoff.F
38!||--- uses -----------------------------------------------------
39!|| h3d_mod ../engine/share/modules/h3d_mod.F
40!|| output_mod ../common_source/modules/output/output_mod.f90
41!|| tri7box ../engine/share/modules/tri7box.F
42!||====================================================================
43 SUBROUTINE i20for3(OUTPUT,JLT ,A ,VA ,IBCC ,ICODT ,
44 2 FSAV ,GAP ,FRIC ,MS ,VISC ,
45 3 VISCF ,NOINT ,STFA ,ITAB ,CN_LOC ,
46 4 STIGLO ,STIFN ,STIF ,FSKYI ,ISKY ,
47 6 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
48 7 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
49 8 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
50 9 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
51 A P1 ,P2 ,P3 ,P4 ,FCONT ,
52 B IX1L ,IX2L ,IX3L ,IX4L ,NSVG ,
53 C IVIS2 ,NELTST ,ITYPTST,DT2T ,
54 D GAPV ,INACTI ,INDEX ,NISKYFI,
55 E KINET ,NEWFRONT,ISECIN,NSTRF ,SECFCUM,
56 F X ,XA ,CE_LOC ,MFROT ,IFQ ,
57 G FROT_P ,CAND_FX,CAND_FY,CAND_FZ,ALPHA0,
58 H IFPEN ,GAPR ,DXANC ,NLN ,NLG ,
59 I IBAG ,ICONTACT,NSV ,PENIS ,PENIM ,
60 J VISCN ,VXI ,VYI ,VZI ,MSI ,
61 K KINI ,NIN ,NISUB ,LISUB ,ADDSUBS,
62 L ADDSUBM,LISUBS ,LISUBM ,FSAVSUB,CAND_N ,
63 M ILAGM ,ICURV ,NOD_NORMAL ,FNCONT ,FTCONT ,
64 N X1 ,X2 ,X3 ,X4 ,Y1 ,
65 O Y2 ,Y3 ,Y4 ,Z1 ,Z2 ,
66 P Z3 ,Z4 ,XI ,YI ,ZI ,
67 Q IADM ,RCURVI ,RCONTACT,ACONTACT,PCONTACT,
68 R ANGLMI ,PADM ,INTTH ,PHI , FTHE ,
69 S FTHESKYI,DAANC6,TEMP ,TEMPI ,RSTIF ,
70 T IFORM ,GAP_S ,IGAP ,ALPHAK ,MSKYI_SMS,
71 U ISKYI_SMS,NSMS ,CMAJ ,JTASK,ISENSINT,
72 V FSAVPARIT ,NFT ,H3D_DATA)
73C-----------------------------------------------
74C M o d u l e s
75C-----------------------------------------------
76 USE tri7box
77 USE h3d_mod
78 USE output_mod
79C-----------------------------------------------
80C I m p l i c i t T y p e s
81C-----------------------------------------------
82#include "implicit_f.inc"
83#include "comlock.inc"
84C-----------------------------------------------
85C G l o b a l P a r a m e t e r s
86C-----------------------------------------------
87#include "mvsiz_p.inc"
88C-----------------------------------------------
89C C o m m o n B l o c k s
90C-----------------------------------------------
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"
107C-----------------------------------------------
108C D u m m y A r g u m e n t s
109C-----------------------------------------------
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(MVSIZ), 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
123 my_real
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(*)
130 my_real
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,*)
147 my_real
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
153C-----------------------------------------------
154C L o c a l V a r i a b l e s
155C-----------------------------------------------
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)
159 my_real
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)
177 my_real
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
193C
194 DOUBLE PRECISION FX6(6,MVSIZ), FY6(6,MVSIZ), FZ6(6,MVSIZ)
195C
196C-----------------------------------------------
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
216C--------------------------------------------------------
217C only for quadrilateral packet
218C--------------------------------------------------------
219C--------------------------------------------------------
220C case of mixed packets
221C--------------------------------------------------------
222 IF(icurv(1) == 3) THEN
223 DO i=1,jlt
224C
225 bb = gapv(i)+cmaj(i)
226C
227 d1 = sqrt(p1(i))
228 p1(i) = max(zero, bb - d1)
229C
230 d2 = sqrt(p2(i))
231 p2(i) = max(zero, bb - d2)
232C
233 d3 = sqrt(p3(i))
234 p3(i) = max(zero, bb - d3)
235C
236 d4 = sqrt(p4(i))
237 p4(i) = max(zero, bb - d4)
238C
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
249C
250 d1 = sqrt(p1(i))
251 p1(i) = max(zero, gapv(i) - d1)
252C
253 d2 = sqrt(p2(i))
254 p2(i) = max(zero, gapv(i) - d2)
255C
256 d3 = sqrt(p3(i))
257 p3(i) = max(zero, gapv(i) - d3)
258C
259 d4 = sqrt(p4(i))
260 p4(i) = max(zero, gapv(i) - d4)
261C
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
271C
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
293C
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
305C---------------------
306C COURBURE FIXE
307C---------------------
308 IF(icurv(1)==1)THEN
309C spherical (only concave for now)
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)
316C
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
351C cylindrical (only concave for now)
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)
432C --
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
464C --
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
497C
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
509C correction hourglass
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
519C---------------------
520C PENE INITIALE
521C---------------------
522 IF(inacti==5.or.inacti==6)THEN
523c DO I=1,JLT
524creduction of initial penetration
525cC CAND_P(INDEX(I))=MIN(CAND_P(INDEX(I)),PENE(I))
526c CAND_P(INDEX(I))=MIN(CAND_P(INDEX(I)),
527c . ( (ONE-FIVEEM2)*CAND_P(INDEX(I))
528c . +FIVEEM2*(PENE(I)+FIVEEM2*(GAPV(I)-PENE(I)))) )
529csubtraction of initial penetration from penetration and gap
530c PENE(I)=MAX(ZERO,PENE(I)-CAND_P(INDEX(I)))
531c IF( PENE(I)==ZERO ) STIF(I) = ZERO
532c GAPV(I)=GAPV(I)-CAND_P(INDEX(I))
533c ENDDO
534#include "lockon.inc"
535C---
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
551 penfi(nin)%P(2,-nn) = max(penfi(nin)%P(2,-nn),pplus)
552 ELSE
553 penfi(nin)%P(2,-nn) = max(penfi(nin)%P(2,-nn),
554 + gapfi(nin)%P(-nn))
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
566C---
567c DO I=1,JLT
568c AAA = GAP_S(IS)/GAPV(I)
569c PPLUS=(PENE(I)+ZEP05*(GAPV(I)-PENE(I)))
570c NN = NSVG(I)
571c IF(NN > 0) THEN
572c PENIS(2,CN_LOC(I)) = MAX(PENIS(2,CN_LOC(I)),AAA*PPLUS)
573c ELSE
574c PENFI(NIN)%P(2,-NN) = MAX(PENFI(NIN)%P(2,-NN),AAA*PPLUS)
575c END IF
576c PENIM(2,CE_LOC(I)) = MAX(PENIM(2,CE_LOC(I)),(ONE-AAA)*PPLUS)
577c ENDDO
578C---
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
595C---------------------
596C
597 dti = 1.e20
598C
599 DO 600 i=1,jlt
600 dist=gapv(i)-pene(i)
601 rdist = half*dist / max(em30,-vn(i))
602 dti = min(rdist,dti)
603 600 CONTINUE
604C intermediate variable coming from starter input deck interface cards
605C not read for this type of interface
606 dtmini=ep20
607C
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 ELSEIF(idtmin(10)==6.AND.ilagm==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
675C-------------------------------------------
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
759C---------------------------------
760C DAMPING + FRIC
761C---------------------------------
762.OR. IF(VISC/=ZEROVISCF/=ZERO)THEN
763 IF(IVIS2==0)THEN
764C---------------------------------
765C VISC QUAD TYPE V227
766C---------------------------------
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
772C---------------------------------
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
807C---------------------------------
808C TEST
809C---------------------------------
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
820C---------------------------------
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
855C---------------------------------
856C VISC QUAD TYPE
857C---------------------------------
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
878C---------------------------------
879C VISC QUAD = 0
880C---------------------------------
881 DO I=1,JLT
882 VIS2(I) = TWO * STIF(I) * MSI(I)
883 ENDDO
884C---------------------------------
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
898C---------------------------------
899C VISC = 0
900C---------------------------------
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
909C---------------------------------
910C Visc = 2m/dt => For visc <1, stable: Dt <2m/visc = Dt
911C M = m1*m2/m1+m2 for visc = 1, elastic shock
912C For visc = 0.5, elastic collision
913C---------------------------------
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
938C---------------------------------
939C REDUCTION RIGIDITE ANCRAGE
940C---------------------------------
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
962C SPMD remote SECONDARYs
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"
969C---------------------------------
970C SAUVEGARDE DE L'IMPULSION NORMALE
971C---------------------------------
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"
1005C
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
1013c
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
1034C In SPMD: Treatment to be redone after reception node Remote if JG <0
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
1047C---------------------------------
1048C SORTIES TH PAR SOUS INTERFACE
1049C---------------------------------
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
1071C MAIN side :
1072 FSAVSUB1(1,JSUB)=FSAVSUB1(1,JSUB)+IMPX
1073 FSAVSUB1(2,JSUB)=FSAVSUB1(2,JSUB)+IMPY
1074 FSAVSUB1(3,JSUB)=FSAVSUB1(3,JSUB)+IMPZ
1075C
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)
1079C
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
1096C loop split because of a PGI bug
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
1112C MAIN side :
1113 FSAVSUB1(1,JSUB)=FSAVSUB1(1,JSUB)+IMPX
1114 FSAVSUB1(2,JSUB)=FSAVSUB1(2,JSUB)+IMPY
1115 FSAVSUB1(3,JSUB)=FSAVSUB1(3,JSUB)+IMPZ
1116C
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)
1120C
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
1140C---------------------------------
1141C NEW FRICTION MODELS
1142C---------------------------------
1143 IF (MFROT==0) THEN
1144C--- Coulomb friction
1145 DO I=1,JLT
1146 XMU(I) = FRIC
1147 ENDDO
1148 ELSEIF (MFROT==1) THEN
1149C--- Viscous friction
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
1171C--- Loi Darmstad
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
1195C--- Renard
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
1217C--- Exponential decay model
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
1229C------------------
1230C TANGENT FORCE CALCULATION
1231C------------------
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
1242C---------------------------------
1243C INCREMENTAL (STIFFNESS) FORMULATION
1244C---------------------------------
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
1279C------- total force
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
1286C---------------------------------
1287C TOTAL (VISCOUS) FORMULATION + FRICTION FILTERING
1288C---------------------------------
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
1321C------- total force
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
1329C---------------------------------
1330C TOTAL (VISCOUS) FORMULATION / NO FRICTION FILTERING
1331C---------------------------------
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)
1348C------- total force
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
1355C---------------------------------
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
1376C In SPMD: Treatment to be redone after reception node Remote if JG <0
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
1390C---------------------------------
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"
1416C
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
1424C
1425C---------------------------------
1426C SORTIES TH PAR SOUS INTERFACE
1427C---------------------------------
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
1444C MAIN side :
1445 FSAVSUB1(4,JSUB)=FSAVSUB1(4,JSUB)+IMPX
1446 FSAVSUB1(5,JSUB)=FSAVSUB1(5,JSUB)+IMPY
1447 FSAVSUB1(6,JSUB)=FSAVSUB1(6,JSUB)+IMPZ
1448C
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)
1455C
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
1490C MAIN side :
1491 FSAVSUB1(4,JSUB)=FSAVSUB1(4,JSUB)+IMPX
1492 FSAVSUB1(5,JSUB)=FSAVSUB1(5,JSUB)+IMPY
1493 FSAVSUB1(6,JSUB)=FSAVSUB1(6,JSUB)+IMPZ
1494C
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)
1501C
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
1529C---------------------------------
1530#include "lockon.inc"
1531 ECONTV = ECONTV + ECONVT
1532 ECONT = ECONT + ECONTT
1533#include "lockoff.inc"
1534C---------------------------------
1535 IF(KDTINT==1)THEN
1536.OR. IF( (VISC/=ZEROVISCF/=ZERO)
1537.AND..OR. . (IVIS2==0IVIS2==1))THEN
1538 DO I=1,JLT
1539C C (i) = 2.*C (i)
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
1559C
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
1580C
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
1601C
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
1622C
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
1644C
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 ELSEIF(idtmin(10)==6.AND.ilagm==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
1792C=======================================================================
1793C forces on main nodes
1794C=======================================================================
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)
1799C
1800 fx2(i)=fxi(i)*h2(i)
1801 fy2(i)=fyi(i)*h2(i)
1802 fz2(i)=fzi(i)*h2(i)
1803C
1804 fx3(i)=fxi(i)*h3(i)
1805 fy3(i)=fyi(i)*h3(i)
1806 fz3(i)=fzi(i)*h3(i)
1807C
1808 fx4(i)=fxi(i)*h4(i)
1809 fy4(i)=fyi(i)*h4(i)
1810 fz4(i)=fzi(i)*h4(i)
1811 ENDDO
1812
1813C=======================================================================
1814C Forces Parith on on secondary anchor node
1815C=======================================================================
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"
1820c Second nodes
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
1831C
1832C SPMD remote SECONDARYs
1833C
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
1843c nodes matre
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"
1893C=======================================================================
1894C=======================================================================
1895C set forces to zero on main and secondary nodes
1896C If Pene (on second node) <gapr (gap real)
1897C=======================================================================
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
1916C
1917C SPMD remote SECONDARYs
1918C
1919C ******** Attention DXANCFI to communicate in TRI20BOX ***************
1920C
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
1957C IFPEN(INDEX(I)) = 0
1958 ENDIF
1959 ENDIF
1960 ENDIF
1961 ENDDO
1962C=======================================================================
1963C forces on master and secondary nodes
1964C=======================================================================
1965C---------------------------------
1966 IF(intth == 0 .OR. iform == 0) THEN
1967 DO i=1,jlt
1968 phi1(i) = zero
1969 phi2(i) = zero
1970 phi3(i) = zero
1971 phi4(i) = zero
1972C
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)
1980C
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))
1987C
1988 ax = ay1*az2 - az1*ay2
1989 ay = az1*ax2 - ax1*az2
1990 az = ax1*ay2 - ay1*ax2
1991C
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
2000C SPMD: Identification of interf nodes.useful to send
2001 IF (nspmd>1) THEN
2002Ctmp+1 mic only
2003#include "mic_lockon.inc"
2004 DO i = 1,jlt
2005 nn = nsvg(i)
2006 IF(nn<0)THEN
2007C temporary tag of nsvfi a -
2008 nsvfi(nin)%P(-nn) = -abs(nsvfi(nin)%P(-nn))
2009 ENDIF
2010 ENDDO
2011ctmp+1 mic only
2012#include "mic_lockoff.inc"
2013 ENDIF
2014C
2015 IF(idtmins==2.OR.idtmins_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
2027C
2028 IF(idtmins_int/=0)THEN
2029 stif(1:jlt)=zero
2030 END IF
2031C
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
2061C
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
2072C
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
2095C
2096 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0)THEN
2097#include "lockon.inc"
2098c goto 1234
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
2114C In SPMD: Treatment to be redone after reception node Remote if JG <0
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
2120c 1234 continue
2121#include "lockoff.inc"
2122 ENDIF
2123C-----------------------------------------------------
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
2135C beware of signs for force accumulation
2136C To make it conform with CFORC3
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
2160C In SPMD: Treatment to be redone after reception node Remote if JG <0
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
2171C +fsav(section)
2172 ENDIF
2173 k1s=k1s+1
2174 ENDDO
2175 k0=nstrf(k0+24)
2176 ENDDO
2177 ENDIF
2178 ENDIF
2179C-----------------------------------------------------
2180
2181 IF(ibag/=0.OR.iadm/=0)THEN
2182 DO i=1,jlt
2183
2184C IF(PENE(I)/=ZERO)THEN
2185C modified test for consistency with spmd communication (spmd_i7tools)
2186 IF(fxi(i)/=zero.OR.fyi(i)/=zero.OR.fzi(i)/=zero)THEN
2187
2188 jg = nsvg(i)
2189 IF(jg>0) THEN
2190C In SPMD: Treatment to be redone after reception node Remote if JG <0
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
2207C In SPMD: Treatment to be redone after reception node Remote if JG <0
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
2222C In SPMD: Treatment to be redone after reception node Remote if JG <0
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
2231C
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
2240C In SPMD: Treatment to be redone after reception node Remote if JG <0
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
2255C
2256 RETURN
2257 END
2258!||====================================================================
2259!|| i20for3c ../engine/source/interfaces/int20/i20for3.F
2260!||--- called by ------------------------------------------------------
2261!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
2262!||--- uses -----------------------------------------------------
2263!|| icontact_mod ../engine/share/modules/icontact_mod.F
2264!|| tri7box ../engine/share/modules/tri7box.F
2265!||====================================================================
2266 SUBROUTINE i20for3c(NLN ,NLG ,MS ,DXANC ,
2267 2 DVANC ,STFA ,WEIGHT ,INACTI,
2268 3 DAANC6,STFAC,PENIA ,ALPHAK,
2269 4 DAANC ,KMIN )
2270C-----------------------------------------------
2271C M o d u l e s
2272C-----------------------------------------------
2273 USE tri7box
2274 USE icontact_mod
2275C-----------------------------------------------
2276C I m p l i c i t T y p e s
2277C-----------------------------------------------
2278#include "implicit_f.inc"
2279#include "comlock.inc"
2280C-----------------------------------------------
2281C C o m m o n B l o c k s
2282C-----------------------------------------------
2283#include "com06_c.inc"
2284#include "com08_c.inc"
2285#include "scr11_c.inc"
2286C-----------------------------------------------
2287C D u m m y A r g u m e n t s
2288C-----------------------------------------------
2289 INTEGER WEIGHT(*),NLN,INACTI,NLG(*)
2290 my_real
2291 . DVANC(3,*),DXANC(3,*),DAANC(3,*),STFA(*),PENIA(5,*),
2292 . STFAC,MS(*),ALPHAK(3,*),KMIN
2293 DOUBLE PRECISION
2294 . DAANC6(3,6,*)
2295C-----------------------------------------------
2296C L o c a l V a r i a b l e s
2297C-----------------------------------------------
2298 INTEGER I, J
2299
2300 my_real
2301 . DDX,STFR,VISR,UNSDT2,FX,FY,FZ,ECONTT, ECONVT,
2302 . FXR(NLN), FYR(NLN), FZR(NLN),DX(NLN),DY(NLN),DZ(NLN)
2303 DOUBLE PRECISION
2304 . FX6(6,NLN), FY6(6,NLN), FZ6(6,NLN)
2305
2306C-----------------------------------------------
2307
2308 unsdt2 = dt2/max(dt2*dt2,em30)
2309
2310C----------------------------------------------------------------------
2311C penetration initiale
2312C
2313C Penia (1: 3, i) Normally director vector
2314C penia(4,i) magnitude of initial penetration
2315C penia(4,i) corrected magnitude for next cycle
2316C----------------------------------------------------------------------
2317 IF(inacti >= 5)THEN
2318 DO i = 1,nln
2319 dx(i) = dxanc(1,i) - penia(1,i)*penia(4,i)
2320 dy(i) = dxanc(2,i) - penia(2,i)*penia(4,i)
2321 dz(i) = dxanc(3,i) - penia(3,i)*penia(4,i)
2322 ddx = dx(i)*penia(1,i) + dy(i)*penia(2,i) + dz(i)*penia(3,i)
2323 ddx = half*min(ddx,zero)
2324 penia(5,i) = max(zero,penia(5,i),penia(4,i)+ddx)
2325c To be done here or in i20buce_cript if (Penia (5, i) /= zero) nacti = nacti+1
2326 ENDDO
2327 ELSE
2328 DO i = 1,nln
2329 dx(i) = dxanc(1,i)
2330 dy(i) = dxanc(2,i)
2331 dz(i) = dxanc(3,i)
2332 ENDDO
2333 ENDIF
2334C----------------------------------------------------------------------
2335C NODES MAIN SECONDARY edge
2336C----------------------------------------------------------------------
2337
2338 econtt = zero
2339 econvt = zero
2340 econtv = zero
2341 DO i = 1,nln
2342 j = nlg(i)
2343 IF(stfac > zero)THEN
2344c STFR = HALF * STFAC * ABS(STFA(I))
2345 stfr = half * max(kmin,stfac*abs(stfa(i))) * alphak(1,i)
2346 ELSE
2347c STFR = HALF * ABS(STFAC)
2348 stfr = half * abs(stfac) * alphak(1,i)
2349 ENDIF
2350c Critical viscosite test
2351c VISR = 0.1 * TWO * SQRT(STFR * MS(J))
2352 visr = two * sqrt(stfr * ms(j))
2353
2354 fx = stfr * dx(i)
2355 fy = stfr * dy(i)
2356 fz = stfr * dz(i)
2357 fxr(i) = fx + visr * dvanc(1,i)
2358 fyr(i) = fy + visr * dvanc(2,i)
2359 fzr(i) = fz + visr * dvanc(3,i)
2360 IF(fx /= zero)alphak(3,i)=min(alphak(3,i),fxr(i)/fx)
2361 IF(fy /= zero)alphak(3,i)=min(alphak(3,i),fyr(i)/fy)
2362 IF(fz /= zero)alphak(3,i)=min(alphak(3,i),fzr(i)/fz)
2363 daanc(1,i) = - fxr(i)
2364 daanc(2,i) = - fyr(i)
2365 daanc(3,i) = - fzr(i)
2366
2367 IF(weight(j) == 1)THEN
2368 econtt = econtt + half*stfr*(dx(i)**2+dy(i)**2+dz(i)**2)
2369 econvt = econvt
2370 . + visr*(dvanc(1,i)**2+dvanc(2,i)**2+dvanc(3,i)**2)
2371 ENDIF
2372 ENDDO
2373
2374#include "lockon.inc"
2375 econtv = econtv + econvt*dt1
2376 econt = econt + econtt
2377#include "lockoff.inc"
2378
2379 RETURN
2380 END
2381!||====================================================================
2382!|| i20for3e ../engine/source/interfaces/int20/i20for3.F
2383!||--- called by ------------------------------------------------------
2384!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
2385!||--- calls -----------------------------------------------------
2386!|| foat_to_6_float ../engine/source/system/parit.F
2387!|| i20ass0 ../engine/source/interfaces/int20/i20for3.F
2388!|| i20ass05 ../engine/source/interfaces/int20/i20for3.F
2389!|| i20ass2 ../engine/source/interfaces/int20/i20for3.F
2390!|| i20ass25 ../engine/source/interfaces/int20/i20for3.F
2391!|| i20sms2e ../engine/source/interfaces/int20/i20sms2.F
2392!||--- uses -----------------------------------------------------
2393!|| h3d_mod ../engine/share/modules/h3d_mod.F
2394!|| tri7box ../engine/share/modules/tri7box.F
2395!||====================================================================
2396 SUBROUTINE i20for3e(
2397 1 JLT ,A ,V ,IBC ,ICODT ,
2398 2 FSAV ,GAP ,FRIC ,MS ,VISC ,
2399 3 VISCF ,NOINT ,ITAB ,CS_LOC ,CM_LOC ,
2400 4 STIGLO ,STIFN ,STIF ,FSKYI ,ISKY ,
2401 5 FCONT ,STFS ,STFM ,DT2T ,HS1 ,
2402 6 HS2 ,HM1 ,HM2 ,N1 ,N2 ,
2403 7 M1 ,M2 ,IVIS2 ,NELTST ,ITYPTST,
2404 8 NX ,NY ,NZ ,GAPV ,PENISE ,
2405 9 PENIME ,INACTI,NISKYFIE,NEWFRONT,ISECIN ,
2406 A NSTRF ,SECFCUM,VISCN ,NLINSA ,MS1 ,
2407 B MS2 ,MM1 ,MM2 ,VXS1 ,VYS1 ,
2408 C VZS1 ,VXS2 ,VYS2 ,VZS2 ,VXM1 ,
2409 D VYM1 ,VZM1 ,VXM2 ,VYM2 ,VZM2 ,
2410 E NIN ,N1L ,N2L ,M1L ,M2L ,
2411 F DAANC6 ,ALPHAK ,MSKYI_SMS,ISKYI_SMS,NSMS,
2412 G JTASK ,ISENSINT, FSAVPARIT ,NISUB ,NFT,
2413 H H3D_DATA)
2414C-----------------------------------------------
2415C M o d u l e s
2416C-----------------------------------------------
2417 USE tri7box
2418 USE h3d_mod
2419C-----------------------------------------------
2420C I m p l i c i t T y p e s
2421C-----------------------------------------------
2422#include "implicit_f.inc"
2423#include "comlock.inc"
2424C-----------------------------------------------
2425C G l o b a l P a r a m e t e r s
2426C-----------------------------------------------
2427#include "mvsiz_p.inc"
2428C-----------------------------------------------
2429C C o m m o n B l o c k s
2430C-----------------------------------------------
2431#include "com01_c.inc"
2432#include "com04_c.inc"
2433#include "com06_c.inc"
2434#include "com08_c.inc"
2435#include "scr05_c.inc"
2436#include "scr07_c.inc"
2437#include "scr11_c.inc"
2438#include "scr14_c.inc"
2439#include "scr16_c.inc"
2440#include "scr18_c.inc"
2441#include "units_c.inc"
2442#include "parit_c.inc"
2443#include "impl1_c.inc"
2444#include "sms_c.inc"
2445C-----------------------------------------------
2446C D u m m y A r g u m e n t s
2447C-----------------------------------------------
2448 INTEGER NELTST,ITYPTST,JLT,IBC,IVIS2,INACTI,NLINSA,NISKYFIE,NIN
2449 INTEGER ICODT(*), ITAB(*), ISKY(*),
2450 . NOINT,NEWFRONT,ISECIN, NSTRF(*), ISKYI_SMS(*)
2451 INTEGER N1(MVSIZ), N2(MVSIZ), M1(MVSIZ), M2(MVSIZ),
2452 . N1L(MVSIZ),N2L(MVSIZ),M1L(MVSIZ),M2L(MVSIZ),
2453 . CS_LOC(MVSIZ), CM_LOC(MVSIZ), NSMS(MVSIZ),JTASK,
2454 . ISENSINT(*),NISUB,NFT
2455 my_real
2456 . STIGLO,
2457 . A(3,*), MS(*), V(3,*), FSAV(*),FCONT(3,*),
2458 . STFS(*),STFM(*),STIFN(*),FSKYI(LSKYI,NFSKYI),GAPV(*),
2459 . PENISE(2,*), PENIME(2,*),ALPHAK(3,*), MSKYI_SMS(*),
2460 . GAP, FRIC,VISC,VISCF,VIS,DT2T
2461 my_real
2462 . HS1(MVSIZ), HS2(MVSIZ), HM1(MVSIZ), HM2(MVSIZ),
2463 . NX(MVSIZ), NY(MVSIZ), NZ(MVSIZ), STIF(MVSIZ),
2464 . SECFCUM(7,NUMNOD,NSECT), VISCN(*),
2465 . MS1(MVSIZ),MS2(MVSIZ),MM1(MVSIZ),MM2(MVSIZ),
2466 . vxs1(mvsiz),vys1(mvsiz),vzs1(mvsiz),vxs2(mvsiz),vys2(mvsiz),
2467 . vzs2(mvsiz),vxm1(mvsiz),vym1(mvsiz),vzm1(mvsiz),vxm2(mvsiz),
2468 . vym2(mvsiz),vzm2(mvsiz),fsavparit(nisub+1,11,*)
2469 DOUBLE PRECISION DAANC6(3,6,*)
2470 TYPE(H3D_DATABASE) :: H3D_DATA
2471C-----------------------------------------------
2472C L o c a l V a r i a b l e s
2473C-----------------------------------------------
2474 INTEGER I, J1, J , K0,NBINTER,K1S,K, NI, IL, IG
2475 INTEGER NISKYL,NISKYL1,ISIGN
2476 my_real
2477 . VX(MVSIZ), VY(MVSIZ), VZ(MVSIZ), VN(MVSIZ),
2478 . FXI(MVSIZ), FYI(MVSIZ), FZI(MVSIZ), FNI(MVSIZ),
2479 . FX1(MVSIZ), FX2(MVSIZ), FX3(MVSIZ), FX4(MVSIZ),
2480 . FY1(MVSIZ), FY2(MVSIZ), FY3(MVSIZ), FY4(MVSIZ),
2481 . FZ1(MVSIZ), FZ2(MVSIZ), FZ3(MVSIZ), FZ4(MVSIZ),
2482 . PENE(MVSIZ),MASMIN(MVSIZ),
2483 . VIS2(MVSIZ), DTMI(MVSIZ),
2484 . VNX, VNY, VNZ, AA, VMAX,S2,DIST,RDIST,
2485 . V2, FM2, DT1INV, VISCA, FAC, FF,
2486 . FX, FY, FZ, F2, MAS2, DTMI0,DTI,
2487 . FACM1, ECONTT, ECONVT, A2,MASM,
2488 . FSAV1, FSAV2, FSAV3, FSAV4, FSAV5, FSAV6,
2489 . DTI2, PPLUS
2490 my_real PREC
2491 my_real
2492 . ST1(MVSIZ),ST2(MVSIZ),ST3(MVSIZ),ST4(MVSIZ),
2493 . KT(MVSIZ),C(MVSIZ),CF(MVSIZ),
2494 . K1(MVSIZ),K2(MVSIZ),K3(MVSIZ),K4(MVSIZ),
2495 . C1(MVSIZ),C2(MVSIZ),C3(MVSIZ),C4(MVSIZ),
2496 . CX,CY,CFI,AUX,AAA
2497 double precision
2498 . fx6(6,mvsiz), fy6(6,mvsiz), fz6(6,mvsiz)
2499C-----------------------------------------------
2500 IF (iresp == 1) THEN
2501 prec = fiveem4
2502 ELSE
2503 prec = em10
2504 ENDIF
2505 IF(dt1>zero)THEN
2506 dt1inv = one/dt1
2507 ELSE
2508 dt1inv =zero
2509 ENDIF
2510 econtt = zero
2511 econvt = zero
2512C
2513 DO i=1,jlt
2514 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
2515 pene(i) = gapv(i) - s2
2516 s2 = one/max(em30,s2)
2517 nx(i) = nx(i)*s2
2518 ny(i) = ny(i)*s2
2519 nz(i) = nz(i)*s2
2520 ENDDO
2521C
2522 IF(inacti==5.or.inacti==6)THEN
2523#include "lockon.inc"
2524 DO i=1,jlt
2525 pplus=half*(pene(i)+fiveem2*(gapv(i)-pene(i)))
2526 IF(cs_loc(i)<=nlinsa) THEN
2527 penise(2,cs_loc(i)) = max(penise(2,cs_loc(i)),pplus)
2528 ELSE
2529 ni = cs_loc(i)-nlinsa
2530 penfie(nin)%P(2,ni) = max(penfie(nin)%P(2,ni),pplus)
2531 END IF
2532 penime(2,cm_loc(i)) = max(penime(2,cm_loc(i)),pplus)
2533 ENDDO
2534#include "lockoff.inc"
2535 DO i=1,jlt
2536 IF(cs_loc(i)<=nlinsa) THEN
2537 pene(i) = pene(i) - penise(1,cs_loc(i)) - penime(1,cm_loc(i))
2538 pene(i) = max(pene(i),zero)
2539 IF(pene(i)==zero)stif(i)=zero
2540 gapv(i) = gapv(i) - penise(1,cs_loc(i)) - penime(1,cm_loc(i))
2541 ELSE
2542 ni = cs_loc(i)-nlinsa
2543 pene(i) = pene(i) - penfie(nin)%P(1,ni) - penime(1,cm_loc(i))
2544 pene(i) = max(pene(i),zero)
2545 IF(pene(i)==zero)stif(i)=zero
2546 gapv(i) = gapv(i) - penfie(nin)%P(1,ni) - penime(1,cm_loc(i))
2547 END IF
2548 END DO
2549 ENDIF
2550
2551 vmax = zero
2552 DO i=1,jlt
2553 gapv(i) = zep9*gapv(i)
2554 vx(i) = hs1(i)*vxs1(i) + hs2(i)*vxs2(i)
2555 . - hm1(i)*vxm1(i) - hm2(i)*vxm2(i)
2556 vy(i) = hs1(i)*vys1(i) + hs2(i)*vys2(i)
2557 . - hm1(i)*vym1(i) - hm2(i)*vym2(i)
2558 vz(i) = hs1(i)*vzs1(i) + hs2(i)*vzs2(i)
2559 . - hm1(i)*vzm1(i) - hm2(i)*vzm2(i)
2560 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
2561 ENDDO
2562C-------------------------------------------
2563 DO i=1,jlt
2564 fac = gapv(i)/max( em10,( gapv(i)-pene(i) ) )
2565 facm1 = one/fac
2566 IF(( (gapv(i)-pene(i))/gapv(i) )<prec .AND.
2567 . stif(i)>zero ) THEN
2568 stif(i) = zero
2569 IF (impl_s==0) THEN
2570 newfront = -1
2571#include "lockon.inc"
2572 IF(cs_loc(i)<=nlinsa)THEN
2573 stfs(cs_loc(i)) = -abs(stfs(cs_loc(i)))
2574 WRITE(istdo,*)'WARNING INTERFACE NB',noint
2575 WRITE(istdo,*)'LINE CONNECTING NODES ',itab(n1(i)),
2576 . itab(n2(i)),'DE-ACTIVATED FROM INTERFACE'
2577 WRITE(istdo,*)'IMPACTED ON ',itab(m1(i)),itab(m2(i))
2578 WRITE(iout,*)'WARNING INTERFACE NB',noint
2579 WRITE(iout,*)'GAP=',gapv(i),'PENE=',pene(i)
2580 WRITE(iout,*)'LINE CONNECTING NODES ',itab(n1(i)),
2581 . itab(n2(i)),'DE-ACTIVATED FROM INTERFACE'
2582 WRITE(iout,*)'IMPACTED ON ',itab(m1(i)),itab(m2(i))
2583 ELSE
2584 ni = cs_loc(i)-nlinsa
2585 stifie(nin)%P(ni) = -abs(stifie(nin)%P(ni))
2586 WRITE(istdo,*)'WARNING INTERFACE NB',noint
2587 WRITE(istdo,*)'LINE CONNECTING NODES ',itafie(nin)%P(n1(i)),
2588 . itafie(nin)%P(n2(i)),'DE-ACTIVATED FROM INTERFACE'
2589 WRITE(iout,*)'WARNING INTERFACE NB',noint
2590 WRITE(iout,*)'GAP=',gapv(i),'PENE=',pene(i)
2591 WRITE(iout,*)'LINE CONNECTING NODES ',itafie(nin)%P(n1(i)),
2592 . itafie(nin)%P(n2(i)),'DE-ACTIVATED FROM INTERFACE'
2593 END IF
2594#include "lockoff.inc"
2595 ENDIF
2596 pene(i)= zero
2597 ENDIF
2598 econtt = econtt + half*stif(i)*gapv(i)**2 *( facm1 - one -
2599 . log(facm1) )
2600 stif(i) = half*stif(i) * fac
2601 fni(i)= -stif(i) * pene(i)
2602 ENDDO
2603
2604 dti = ep20
2605C
2606 DO i=1,jlt
2607 dist=gapv(i)-pene(i)
2608 rdist = half*dist / max(em30,-vn(i))
2609 dti = min(rdist,dti)
2610 ENDDO
2611C
2612 IF(dti<=dtmin1(10))THEN
2613 DO i=1,jlt
2614 dist=gapv(i)-pene(i)
2615 dti2 = half*dist / max(em30,-vn(i))
2616 IF(dti2<=dtmin1(10))THEN
2617#include "lockon.inc"
2618 IF(cs_loc(i)<=nlinsa)THEN
2619 WRITE(iout,*)
2620 . ' **WARNING MINIMUM TIME STEP ',dti2,
2621 . 'IN INTERFACE NB',noint
2622 WRITE(iout,*)'SECONDARY NODES NB',itab(n1(i)),
2623 . itab(n2(i))
2624 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
2625 . itab(m2(i))
2626 ELSE
2627 WRITE(iout,*)
2628 . ' **WARNING MINIMUM TIME STEP ',dti2,
2629 . 'IN INTERFACE NB',noint
2630 WRITE(iout,*)'SECONDARY NODES NB',itafie(nin)%P(n1(i)),
2631 . itafie(nin)%P(n2(i))
2632 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
2633 . itab(m2(i))
2634 END IF
2635#include "lockoff.inc"
2636 IF(idtmin(10)==1)THEN
2637 tstop = tt
2638 ELSEIF(idtmin(10)==2)THEN
2639#include "lockon.inc"
2640 WRITE(iout,*)'REMOVE SECONDARY LINE FROM INTERFACE'
2641 IF(cs_loc(i)<=nlinsa)THEN
2642 stfs(cs_loc(i)) = -abs(stfs(cs_loc(i)))
2643 ELSE
2644 ni = cs_loc(i)-nlinsa
2645 stifie(nin)%P(ni) = -abs(stifie(nin)%P(ni))
2646 END IF
2647#include "lockoff.inc"
2648 newfront = -1
2649 stif(i) = zero
2650 dti = dtmin1(10)
2651 ELSEIF(idtmin(10)==5)THEN
2652 mstop = 2
2653 ENDIF
2654 ENDIF
2655 ENDDO
2656 ENDIF
2657C
2658 IF(dti<dt2t)THEN
2659 dt2t = dti
2660 neltst = noint
2661 ityptst = 10
2662 ENDIF
2663C---------------------------------
2664C DAMPING + FRIC
2665C---------------------------------
2666 IF(visc/=zero.OR.viscf/=zero)THEN
2667 DO i=1,jlt
2668 mas2 = ms1(i)*hs1(i)
2669 . + ms2(i)*hs2(i)
2670 masm = mm1(i)*hm1(i)
2671 . + mm2(i)*hm2(i)
2672 masmin(i) = min(mas2,masm)
2673 vis2(i) = two * stif(i) * min(mas2,masm)
2674 ENDDO
2675 ENDIF
2676C---------------------------------
2677 IF(visc/=zero)THEN
2678 IF(ivis2==0.OR.ivis2==1)THEN
2679C---------------------------------
2680C VISC QUAD TYPE V227
2681C---------------------------------
2682 DO i=1,jlt
2683 IF(vn(i)<zero)
2684 . vis2(i) = vis2(i)/(max(em10,(gapv(i)-pene(i))/gapv(i)))
2685 ENDDO
2686C---------------------------------
2687 visca = zep4
2688 IF(kdtint==0.AND.idtmins/=2)THEN
2689 DO i=1,jlt
2690 fac = stif(i) / max(em30,stif(i))
2691 vis = sqrt(vis2(i))
2692 ff = fac * (
2693 . visc * vis +
2694 . visca**2 * two * masmin(i) * max(zero,-vn(i)) /
2695 . max((gapv(i) - pene(i)),em10) )
2696 stif(i) = stif(i) * gapv(i)/max((gapv(i)-pene(i)),em10)
2697 stif(i) = stif(i) + ff * dt1inv
2698 stif(i) = max(stif(i) ,fac*sqrt(viscf)*vis*dt1inv)
2699 ff = min(ff * vn(i),-fni(i))
2700c FF = MIN(FF * VN(I),ZERO)
2701 fni(i) = fni(i) + ff
2702cc ECONVT = ECONVT + FF * VN(I) * DT1
2703 ENDDO
2704
2705 ELSE
2706 DO i=1,jlt
2707 fac = stif(i) / max(em30,stif(i))
2708 vis = sqrt(vis2(i))
2709 c(i)= fac * (
2710 . visc * vis +
2711 . visca**2 * two * masmin(i) * max(zero,-vn(i)) /
2712 . max((gapv(i) - pene(i)),em10) )
2713 stif(i) = stif(i) * gapv(i) / max((gapv(i) - pene(i)),em10)
2714 kt(i) = stif(i)
2715 stif(i) = stif(i) + c(i) * dt1inv
2716 ff = min(c(i) * vn(i),-fni(i))
2717c FF = MIN(FF * VN(I),ZERO)
2718 fni(i) = fni(i) + ff
2719 cf(i) = fac*sqrt(viscf)*vis
2720 stif(i) = max(stif(i) ,cf(i)*dt1inv)
2721cc ECONVT = ECONVT + C(I) * VN(I) * DT1
2722 ENDDO
2723 ENDIF
2724
2725 ELSEIF(ivis2==2)THEN
2726C---------------------------------
2727C VISC QUAD TYPE
2728C---------------------------------
2729 DO i=1,jlt
2730 vis2(i) = vis2(i)/( max(em10,(gapv(i)-pene(i))/gapv(i)))
2731 ENDDO
2732C---------------------------------
2733 visca = half
2734 DO i=1,jlt
2735 fac = stif(i) / max(em30,stif(i))
2736 vis = sqrt(vis2(i))
2737 ff = fac * (
2738 . visc * vis +
2739 . visca**2 * two * masmin(i) * abs(vn(i)) /
2740 . max((gapv(i) - pene(i)),em10) )
2741 stif(i) = stif(i) * gapv(i) / max((gapv(i)-pene(i)),em10)
2742 stif(i) = stif(i) + two * ff * dt1inv
2743 stif(i) = max(stif(i) ,fac*sqrt(viscf)*vis*dt1inv)
2744 ff = min(ff * vn(i),-fni(i))
2745 fni(i) = fni(i) + ff
2746 ENDDO
2747 ELSEIF(ivis2==3)THEN
2748C---------------------------------
2749C VISC QUAD = 0
2750C---------------------------------
2751 DO i=1,jlt
2752 fac = stif(i) / max(em30,stif(i))
2753 vis = sqrt(vis2(i))
2754 ff = fac * ( visc * vis ) /
2755 . max((gapv(i) - pene(i)),em10)
2756 stif(i) = stif(i) * gapv(i) / max((gapv(i)-pene(i)),em10)
2757 stif(i) = stif(i) + two * ff * dt1inv
2758 stif(i) = max(stif(i) ,fac*sqrt(viscf)*vis*dt1inv)
2759 ff = min(ff * vn(i),-fni(i))
2760 fni(i) = fni(i) + ff
2761 ENDDO
2762 ELSEIF(ivis2==4)THEN
2763C---------------------------------
2764C VISC = 0
2765C---------------------------------
2766 DO i=1,jlt
2767 vis = sqrt(vis2(i))
2768 stif(i) = stif(i) * gapv(i) / max((gapv(i)-pene(i)),em10)
2769 stif(i) = max(stif(i) ,fac*sqrt(viscf)*vis*dt1inv)
2770 ENDDO
2771 ELSEIF(ivis2==5)THEN
2772C---------------------------------
2773C Visc = 2m/dt => For visc <1, stable: Dt <2m/visc = Dt
2774C M = m1*m2/m1+m2 for visc = 1, elastic shock
2775C For visc = 0.5, elastic collision
2776C---------------------------------
2777 DO i=1,jlt
2778 mas2 = ms1(i)*hs1(i)
2779 . + ms2(i)*hs2(i)
2780 masm = mm1(i)*hm1(i)
2781 . + mm2(i)*hm2(i)
2782 vis = 2. * visc * dt1inv * masm * mas2 /
2783 . max(em30,masm+mas2)
2784 stif(i) = stif(i) * gapv(i) / max((gapv(i) -pene(i)),em10)
2785 stif(i) = max(stif(i) ,fac*sqrt(viscf*vis2(i))*dt1inv)
2786 ff = vis * vn(i)
2787 econvt = econvt + min(zero,ff-fni(i)) * vn(i) * dt1
2788 fni(i) = min(fni(i),ff)
2789 ENDDO
2790 ELSE
2791 ENDIF
2792 ELSE
2793 DO i=1,jlt
2794 stif(i) = stif(i) * gapv(i) / max((gapv(i) - pene(i)),em10)
2795 ENDDO
2796 ENDIF
2797C---------------------------------
2798C REDUCTION RIGIDITE ANCRAGE
2799C---------------------------------
2800#include "lockon.inc"
2801 DO i=1,jlt
2802 isign=1
2803 IF(pene(i)>zero)isign=-1
2804 aaa = one-pene(i)/gapv(i)
2805 il = m1l(i)
2806 IF(pene(i)>zero.OR.alphak(2,il)<zero)isign=-1
2807 alphak(2,il)=isign*min(abs(alphak(2,il)),aaa)
2808 il = m2l(i)
2809 IF(pene(i)>zero.OR.alphak(2,il)<zero)isign=-1
2810 alphak(2,il)=isign*min(abs(alphak(2,il)),aaa)
2811 IF(cs_loc(i) <= nlinsa)THEN
2812 il = n1l(i)
2813 IF(pene(i)>zero.OR.alphak(2,il)<zero)isign=-1
2814 alphak(2,il)=isign*min(abs(alphak(2,il)),aaa)
2815 il = n2l(i)
2816 IF(pene(i)>zero.OR.alphak(2,il)<zero)isign=-1
2817 alphak(2,il)=isign*min(abs(alphak(2,il)),aaa)
2818 ELSE
2819C SPMD remote SECONDARYs
2820 il = n1(i)
2821 IF(pene(i)>zero.OR.alphak(2,il)<zero)isign=-1
2822 alphakfie(nin)%P(il)=isign*min(abs(alphakfie(nin)%P(il)),aaa)
2823 il = n2(i)
2824 IF(pene(i)>zero.OR.alphak(2,il)<zero)isign=-1
2825 alphakfie(nin)%P(il)=isign*min(abs(alphakfie(nin)%P(il)),aaa)
2826 ENDIF
2827 ENDDO
2828#include "lockoff.inc"
2829C---------------------------------
2830C SAUVEGARDE DE L'IMPULSION NORMALE
2831C---------------------------------
2832 fsav1 = zero
2833 fsav2 = zero
2834 fsav3 = zero
2835 DO i=1,jlt
2836 fxi(i)=nx(i)*fni(i)
2837 fyi(i)=ny(i)*fni(i)
2838 fzi(i)=nz(i)*fni(i)
2839 fsav1=fsav1+fxi(i)*dt12
2840 fsav2=fsav2+fyi(i)*dt12
2841 fsav3=fsav3+fzi(i)*dt12
2842 ENDDO
2843 IF (imconv==1) THEN
2844#include "lockon.inc"
2845 fsav(1)=fsav(1)+fsav1
2846 fsav(2)=fsav(2)+fsav2
2847 fsav(3)=fsav(3)+fsav3
2848#include "lockoff.inc"
2849 ENDIF
2850 IF(isensint(1)/=0) THEN
2851 DO i=1,jlt
2852 fsavparit(1,1,i+nft) = fxi(i)
2853 fsavparit(1,2,i+nft) = fyi(i)
2854 fsavparit(1,3,i+nft) = fzi(i)
2855 ENDDO
2856 ENDIF
2857C---------------------------------
2858C FRICTION
2859C---------------------------------
2860 IF(fric*viscf/=0.)THEN
2861 fsav4 = zero
2862 fsav5 = zero
2863 fsav6 = zero
2864 DO i=1,jlt
2865 vnx = nx(i)*vn(i)
2866 vny = ny(i)*vn(i)
2867 vnz = nz(i)*vn(i)
2868 vx(i) = vx(i) - vnx
2869 vy(i) = vy(i) - vny
2870 vz(i) = vz(i) - vnz
2871 v2 = vx(i)**2 + vy(i)**2 + vz(i)**2
2872 vis2(i) = viscf * vis2(i)
2873 fm2 = (fric*fni(i))**2
2874 f2 = vis2(i) * v2
2875 a2 = min(f2,fm2) / max(em30,f2)
2876 aa = sqrt(a2 * vis2(i))
2877 fx = aa * vx(i)
2878 fy = aa * vy(i)
2879 fz = aa * vz(i)
2880 fsav4 = fsav4 + fx*dt12
2881 fsav5 = fsav5 + fy*dt12
2882 fsav6 = fsav6 + fz*dt12
2883 fxi(i)=fxi(i) + fx
2884 fyi(i)=fyi(i) + fy
2885 fzi(i)=fzi(i) + fz
2886 econvt = econvt + aa * v2 * dt1
2887 ENDDO
2888 IF (imconv==1) THEN
2889#include "lockon.inc"
2890 fsav(4) = fsav(4) + fsav4
2891 fsav(5) = fsav(5) + fsav5
2892 fsav(6) = fsav(6) + fsav6
2893#include "lockoff.inc"
2894 ENDIF
2895 IF(isensint(1)/=0) THEN
2896 DO i=1,jlt
2897 fm2 = (fric*fni(i))**2
2898 f2 = vis2(i) * v2
2899 a2 = min(f2,fm2) / max(em30,f2)
2900 aa = sqrt(a2 * vis2(i))
2901 fsavparit(1,4,i+nft) = aa * vx(i)
2902 fsavparit(1,5,i+nft) = aa * vy(i)
2903 fsavparit(1,6,i+nft) = aa * vz(i)
2904 ENDDO
2905 ENDIF
2906 ENDIF
2907C
2908 IF (imconv==1) THEN
2909#include "lockon.inc"
2910 econtv = econtv + econvt
2911 econt = econt + econtt
2912#include "lockoff.inc"
2913 ENDIF
2914C---------------------------------
2915 DO i=1,jlt
2916 fx1(i)=-fxi(i)*hs1(i)
2917 fy1(i)=-fyi(i)*hs1(i)
2918 fz1(i)=-fzi(i)*hs1(i)
2919C
2920 fx2(i)=-fxi(i)*hs2(i)
2921 fy2(i)=-fyi(i)*hs2(i)
2922 fz2(i)=-fzi(i)*hs2(i)
2923C
2924 fx3(i)=fxi(i)*hm1(i)
2925 fy3(i)=fyi(i)*hm1(i)
2926 fz3(i)=fzi(i)*hm1(i)
2927C
2928 fx4(i)=fxi(i)*hm2(i)
2929 fy4(i)=fyi(i)*hm2(i)
2930 fz4(i)=fzi(i)*hm2(i)
2931C
2932 ENDDO
2933C
2934 IF (nspmd>1) THEN
2935Ctmp+1 mic only
2936#include "mic_lockon.inc"
2937 DO i = 1,jlt
2938 IF(cs_loc(i)>nlinsa)THEN
2939 ni = cs_loc(i)-nlinsa
2940C temporary tag of nsvfi a -
2941 nsvfie(nin)%P(ni) = -abs(nsvfie(nin)%P(ni))
2942 ENDIF
2943 ENDDO
2944ctmp+1 mic only
2945#include "mic_lockoff.inc"
2946 ENDIF
2947C
2948 DO i=1,jlt
2949 stif(i) = two*stif(i)
2950 ENDDO
2951C
2952C---------------------------------
2953 IF(kdtint==1.OR.idtmins==2)THEN
2954 IF( (visc/=zero)
2955 . .AND.(ivis2==0.OR.ivis2==1))THEN
2956 DO i=1,jlt
2957 cx= c(i)*c(i)
2958C
2959 IF(ms1(i)==zero)THEN
2960 k1(i) =zero
2961 c1(i) =zero
2962 ELSE
2963 k1(i)=kt(i)*abs(hs1(i))
2964 c1(i)=c(i)*abs(hs1(i))
2965 cx =four*c1(i)*c1(i)
2966 cy =eight*ms1(i)*k1(i)
2967 aux = sqrt(cx+cy)+two*c1(i)
2968 st1(i)= k1(i)*aux*aux/max(cy,em30)
2969 cfi = cf(i)*abs(hs1(i))
2970 aux = two*cfi*cfi/max(ms1(i),em20)
2971 IF(aux>st1(i))THEN
2972 k1(i) =zero
2973 c1(i) =cfi
2974 ENDIF
2975 ENDIF
2976C
2977 IF(ms2(i)==zero)THEN
2978 k2(i) =zero
2979 c2(i) =zero
2980 ELSE
2981 k2(i)=kt(i)*abs(hs2(i))
2982 c2(i)=c(i)*abs(hs2(i))
2983 cx =four*c2(i)*c2(i)
2984 cy =eight*ms2(i)*k2(i)
2985 aux = sqrt(cx+cy)+two*c2(i)
2986 st2(i)= k2(i)*aux*aux/max(cy,em30)
2987 cfi = cf(i)*abs(hs2(i))
2988 aux = two*cfi*cfi/max(ms2(i),em20)
2989 IF(aux>st2(i))THEN
2990 k2(i) =zero
2991 c2(i) =cfi
2992 ENDIF
2993 ENDIF
2994C
2995 IF(mm1(i)==zero)THEN
2996 k3(i) =zero
2997 c3(i) =zero
2998 ELSE
2999 k3(i)=kt(i)*abs(hm1(i))
3000 c3(i)=c(i)*abs(hm1(i))
3001 cx =four*c3(i)*c3(i)
3002 cy =eight*mm1(i)*k3(i)
3003 aux = sqrt(cx+cy)+two*c3(i)
3004 st3(i)= k3(i)*aux*aux/max(cy,em30)
3005 cfi = cf(i)*abs(hm1(i))
3006 aux = two*cfi*cfi/max(mm1(i),em20)
3007 IF(aux>st3(i))THEN
3008 k3(i) =zero
3009 c3(i) =cfi
3010 ENDIF
3011 ENDIF
3012C
3013 IF(mm2(i)==zero)THEN
3014 k4(i) =zero
3015 c4(i) =zero
3016 ELSE
3017 k4(i)=kt(i)*abs(hm2(i))
3018 c4(i)=c(i)*abs(hm2(i))
3019 cx =four*c4(i)*c4(i)
3020 cy =eight*mm2(i)*k4(i)
3021 aux = sqrt(cx+cy)+two*c4(i)
3022 st4(i)= k4(i)*aux*aux/max(cy,em30)
3023 cfi = cf(i)*abs(hm2(i))
3024 aux = two*cfi*cfi/max(mm2(i),em20)
3025 IF(aux>st4(i))THEN
3026 k4(i) =zero
3027 c4(i) =cfi
3028 ENDIF
3029 ENDIF
3030 ENDDO
3031 ELSE
3032 DO i=1,jlt
3033 k1(i) =stif(i)*abs(hs1(i))
3034 c1(i) =zero
3035 k2(i) =stif(i)*abs(hs2(i))
3036 c2(i) =zero
3037 k3(i) =stif(i)*abs(hm1(i))
3038 c3(i) =zero
3039 k4(i) =stif(i)*abs(hm2(i))
3040 c4(i) =zero
3041 ENDDO
3042 ENDIF
3043 ENDIF
3044C=======================================================================
3045C Forces Parith on on second anchoring node
3046C=======================================================================
3047 CALL foat_to_6_float(1 ,jlt ,fx1, fx6)
3048 CALL foat_to_6_float(1 ,jlt ,fy1, fy6)
3049 CALL foat_to_6_float(1 ,jlt ,fz1, fz6)
3050#include "lockon.inc"
3051 DO i = 1,jlt
3052 IF(cs_loc(i)<=nlinsa)THEN
3053 il = n1l(i)
3054C IG = N1(I)
3055C IF(IG > 0)THEN
3056 DO k = 1,6
3057 daanc6(1,k,il) = daanc6(1,k,il) + fx6(k,i)
3058 daanc6(2,k,il) = daanc6(2,k,il) + fy6(k,i)
3059 daanc6(3,k,il) = daanc6(3,k,il) + fz6(k,i)
3060 ENDDO
3061 ELSE
3062C SPMD remote SECONDARYs
3063C IL = - IG
3064 il = n1(i)
3065 DO k = 1,6
3066 daanc6fie(nin)%P(1,k,il) = daanc6fie(nin)%P(1,k,il)
3067 . + fx6(k,i)
3068 daanc6fie(nin)%P(2,k,il) = daanc6fie(nin)%P(2,k,il)
3069 . + fy6(k,i)
3070 daanc6fie(nin)%P(3,k,il) = daanc6fie(nin)%P(3,k,il)
3071 . + fz6(k,i)
3072 ENDDO
3073 ENDIF
3074 ENDDO
3075#include "lockoff.inc"
3076 CALL foat_to_6_float(1 ,jlt ,fx2, fx6)
3077 CALL foat_to_6_float(1 ,jlt ,fy2, fy6)
3078 CALL foat_to_6_float(1 ,jlt ,fz2, fz6)
3079#include "lockon.inc"
3080 DO i = 1,jlt
3081 IF(cs_loc(i)<=nlinsa)THEN
3082 il = n2l(i)
3083C IG = N2(I)
3084C IF(IG > 0)THEN
3085 DO k = 1,6
3086 daanc6(1,k,il) = daanc6(1,k,il) + fx6(k,i)
3087 daanc6(2,k,il) = daanc6(2,k,il) + fy6(k,i)
3088 daanc6(3,k,il) = daanc6(3,k,il) + fz6(k,i)
3089 ENDDO
3090 ELSE
3091C SPMD remote SECONDARYs
3092 il = n2(i)
3093C IL = - IG
3094 DO k = 1,6
3095 daanc6fie(nin)%P(1,k,il) = daanc6fie(nin)%P(1,k,il)
3096 . + fx6(k,i)
3097 daanc6fie(nin)%P(2,k,il) = daanc6fie(nin)%P(2,k,il)
3098 . + fy6(k,i)
3099 daanc6fie(nin)%P(3,k,il) = daanc6fie(nin)%P(3,k,il)
3100 . + fz6(k,i)
3101 ENDDO
3102 ENDIF
3103 ENDDO
3104#include "lockoff.inc"
3105C=======================================================================
3106C Forces Parith on on main anchor node
3107C=======================================================================
3108 CALL foat_to_6_float(1 ,jlt ,fx3, fx6)
3109 CALL foat_to_6_float(1 ,jlt ,fy3, fy6)
3110 CALL foat_to_6_float(1 ,jlt ,fz3, fz6)
3111#include "lockon.inc"
3112 DO i = 1,jlt
3113 il = m1l(i)
3114 DO k = 1,6
3115 daanc6(1,k,il) = daanc6(1,k,il) + fx6(k,i)
3116 daanc6(2,k,il) = daanc6(2,k,il) + fy6(k,i)
3117 daanc6(3,k,il) = daanc6(3,k,il) + fz6(k,i)
3118 ENDDO
3119 ENDDO
3120#include "lockoff.inc"
3121 CALL foat_to_6_float(1 ,jlt ,fx4, fx6)
3122 CALL foat_to_6_float(1 ,jlt ,fy4, fy6)
3123 CALL foat_to_6_float(1 ,jlt ,fz4, fz6)
3124#include "lockon.inc"
3125 DO i = 1,jlt
3126 il = m2l(i)
3127 DO k = 1,6
3128 daanc6(1,k,il) = daanc6(1,k,il) + fx6(k,i)
3129 daanc6(2,k,il) = daanc6(2,k,il) + fy6(k,i)
3130 daanc6(3,k,il) = daanc6(3,k,il) + fz6(k,i)
3131 ENDDO
3132 ENDDO
3133#include "lockoff.inc"
3134C=======================================================================
3135C set forces to zero on master and secondary nodes
3136C si PENE (su node second) < GAPR (gap reel)
3137C=======================================================================
3138C=======================================================================
3139C forces on master and secondary nodes
3140C=======================================================================
3141C---------------------------------
3142 IF(iparit==0)THEN
3143 IF(kdtint==0)THEN
3144 CALL i20ass0(jlt ,cs_loc,n1 ,n2 ,m1 ,
3145 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
3146 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
3147 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
3148 5 fy4 ,fz4 ,a ,stifn,stif ,
3149 6 nlinsa,nin ,jtask)
3150 ELSE
3151 CALL i20ass05(jlt ,cs_loc,n1 ,n2 ,m1 ,
3152 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
3153 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
3154 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
3155 5 fy4 ,fz4 ,a ,stifn,nlinsa,
3156 6 k1 ,k2 ,k3 ,k4 ,c1 ,
3157 7 c2 ,c3 ,c4 ,viscn,nin ,jtask )
3158 END IF
3159 ELSE
3160 IF(kdtint==0)THEN
3161 CALL i20ass2(jlt ,cs_loc ,n1 ,n2 ,m1 ,
3162 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
3163 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
3164 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
3165 5 fy4 ,fz4 ,fskyi ,isky ,niskyfie,
3166 6 stif ,nlinsa ,nin ,noint )
3167 ELSE
3168 CALL i20ass25(jlt ,cs_loc ,n1 ,n2 ,m1 ,
3169 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
3170 3 fx1 ,fy1 ,fz1 ,fx2 ,fy2 ,
3171 4 fz2 ,fx3 ,fy3 ,fz3 ,fx4 ,
3172 5 fy4 ,fz4 ,isky ,niskyfie,nlinsa ,
3173 6 k1 ,k2 ,k3 ,k4 ,c1 ,
3174 7 c2 ,c3 ,c4 ,nin , noint)
3175 END IF
3176 END IF
3177C
3178 IF(idtmins==2)
3179 . CALL i20sms2e(jlt ,cs_loc ,n1 ,n2 ,m1 ,
3180 2 m2 ,hs1 ,hs2 ,hm1 ,hm2 ,
3181 3 stif ,nin ,noint ,mskyi_sms ,iskyi_sms,
3182 4 nsms ,k1 ,k2 ,k3 ,k4 ,
3183 5 c1 ,c2 ,c3 ,c4 ,nlinsa )
3184C
3185 IF(idtmin(10)==1.OR.idtmin(10)==2)THEN
3186 dtmi0 = ep20
3187 DO i=1,jlt
3188 dtmi(i) = ep20
3189 mas2 = two * masmin(i)
3190 IF(mas2>zero.AND.stif(i)>zero)THEN
3191 dtmi(i) = min(dtmi(i),dtfac1(10)*sqrt(mas2/stif(i)))
3192 ENDIF
3193 dtmi0 = min(dtmi0,dtmi(i))
3194 ENDDO
3195 IF(dtmi0<=dtmin1(10))THEN
3196 DO i=1,jlt
3197 IF(dtmi(i)<=dtmin1(10))THEN
3198 IF(idtmin(10)==1)THEN
3199#include "lockon.inc"
3200 IF(cs_loc(i)<=nlinsa) THEN
3201 WRITE(iout,*)
3202 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
3203 . ' IN INTERFACE NB',noint
3204 WRITE(iout,*)'SECONDARY NODES NB',itab(n1(i)),
3205 . itab(n2(i))
3206 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
3207 . itab(m2(i))
3208 ELSE
3209 WRITE(iout,*)
3210 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
3211 . ' IN INTERFACE NB',noint
3212 WRITE(iout,*)'SECONDARY NODES NB',itafie(nin)%P(n1(i)),
3213 . itafie(nin)%P(n2(i))
3214 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
3215 . itab(m2(i))
3216 END IF
3217#include "lockoff.inc"
3218 tstop = tt
3219 ELSEIF(idtmin(10)==2)THEN
3220#include "lockon.inc"
3221 IF(cs_loc(i)<=nlinsa) THEN
3222 WRITE(iout,*)
3223 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
3224 . ' IN INTERFACE NB',noint
3225 WRITE(iout,*)'SECONDARY NODES NB',itab(n1(i)),
3226 . itab(n2(i))
3227 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
3228 . itab(m2(i))
3229 WRITE(iout,*)'DELETE SECONDARY LINE FROM INTERFACE'
3230 stfs(cs_loc(i)) = -abs(stfs(cs_loc(i)))
3231 ELSE
3232 ni = cs_loc(i)-nlinsa
3233 WRITE(iout,*)
3234 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
3235 . ' IN INTERFACE NB',noint
3236 WRITE(iout,*)'SECONDARY NODES NB',itafie(nin)%P(n1(i)),
3237 . itafie(nin)%P(n2(i))
3238 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
3239 . itab(m2(i))
3240 WRITE(iout,*)'DELETE SECONDARY LINE FROM INTERFACE'
3241 stifie(nin)%P(ni) = -abs(stifie(nin)%P(ni))
3242 END IF
3243#include "lockoff.inc"
3244 newfront = -1
3245 ELSEIF(idtmin(10)==5)THEN
3246#include "lockon.inc"
3247 IF(cs_loc(i)<=nlinsa) THEN
3248 WRITE(iout,*)
3249 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
3250 . ' IN INTERFACE NB',noint
3251 WRITE(iout,*)'SECONDARY NODES NB',itab(n1(i)),
3252 . itab(n2(i))
3253 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
3254 . itab(m2(i))
3255 ELSE
3256 WRITE(iout,*)
3257 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
3258 . ' IN INTERFACE NB',noint
3259 WRITE(iout,*)'SECONDARY NODES NB',itafie(nin)%P(n1(i)),
3260 . itafie(nin)%P(n2(i))
3261 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
3262 . itab(m2(i))
3263 END IF
3264#include "lockoff.inc"
3265 mstop = 2
3266 ENDIF
3267 ENDIF
3268 ENDDO
3269 ENDIF
3270 ENDIF
3271C
3272 IF(anim_v(4)+outp_v(4)+h3d_data%N_VECT_CONT>0)THEN
3273#include "lockon.inc"
3274c goto 1234
3275 DO i=1,jlt
3276 IF(cs_loc(i)<=nlinsa) THEN
3277 fcont(1,n1(i)) =fcont(1,n1(i)) + fx1(i)
3278 fcont(2,n1(i)) =fcont(2,n1(i)) + fy1(i)
3279 fcont(3,n1(i)) =fcont(3,n1(i)) + fz1(i)
3280 fcont(1,n2(i)) =fcont(1,n2(i)) + fx2(i)
3281 fcont(2,n2(i)) =fcont(2,n2(i)) + fy2(i)
3282 fcont(3,n2(i)) =fcont(3,n2(i)) + fz2(i)
3283 END IF
3284 fcont(1,m1(i)) =fcont(1,m1(i)) + fx3(i)
3285 fcont(2,m1(i)) =fcont(2,m1(i)) + fy3(i)
3286 fcont(3,m1(i)) =fcont(3,m1(i)) + fz3(i)
3287 fcont(1,m2(i)) =fcont(1,m2(i)) + fx4(i)
3288 fcont(2,m2(i)) =fcont(2,m2(i)) + fy4(i)
3289 fcont(3,m2(i)) =fcont(3,m2(i)) + fz4(i)
3290 ENDDO
3291c 1234 continue
3292#include "lockoff.inc"
3293 ENDIF
3294C
3295 IF(isecin>0)THEN
3296 k0=nstrf(25)
3297 IF(nstrf(1)+nstrf(2)/=0)THEN
3298 DO i=1,nsect
3299 nbinter=nstrf(k0+14)
3300 k1s=k0+30
3301 DO j=1,nbinter
3302 IF(nstrf(k1s)==noint)THEN
3303 IF(isecut/=0)THEN
3304#include "lockon.inc"
3305 DO k=1,jlt
3306 IF(cs_loc(i)<=nlinsa) THEN
3307 IF(secfcum(4,n1(k),i)==1.)THEN
3308 secfcum(1,n1(k),i)=secfcum(1,n1(k),i)-fx1(k)
3309 secfcum(2,n1(k),i)=secfcum(2,n1(k),i)-fy1(k)
3310 secfcum(3,n1(k),i)=secfcum(3,n1(k),i)-fz1(k)
3311 ENDIF
3312 IF(secfcum(4,n2(k),i)==1.)THEN
3313 secfcum(1,n2(k),i)=secfcum(1,n2(k),i)-fx2(k)
3314 secfcum(2,n2(k),i)=secfcum(2,n2(k),i)-fy2(k)
3315 secfcum(3,n2(k),i)=secfcum(3,n2(k),i)-fz2(k)
3316 ENDIF
3317 END IF
3318 IF(secfcum(4,m1(k),i)==1.)THEN
3319 secfcum(1,m1(k),i)=secfcum(1,m1(k),i)-fx3(k)
3320 secfcum(2,m1(k),i)=secfcum(2,m1(k),i)-fy3(k)
3321 secfcum(3,m1(k),i)=secfcum(3,m1(k),i)-fz3(k)
3322 ENDIF
3323 IF(secfcum(4,m2(k),i)==1.)THEN
3324 secfcum(1,m2(k),i)=secfcum(1,m2(k),i)-fx4(k)
3325 secfcum(2,m2(k),i)=secfcum(2,m2(k),i)-fy4(k)
3326 secfcum(3,m2(k),i)=secfcum(3,m2(k),i)-fz4(k)
3327 ENDIF
3328 ENDDO
3329#include "lockoff.inc"
3330 ENDIF
3331C +fsav(section)
3332 ENDIF
3333 k1s=k1s+1
3334 ENDDO
3335 k0=nstrf(k0+24)
3336 ENDDO
3337 ENDIF
3338 ENDIF
3339C
3340 RETURN
3341 END
3342C
3343!||====================================================================
3344!|| i20ass0 ../engine/source/interfaces/int20/i20for3.F
3345!||--- called by ------------------------------------------------------
3346!|| i20for3e ../engine/source/interfaces/int20/i20for3.F
3347!||--- uses -----------------------------------------------------
3348!|| tri7box ../engine/share/modules/tri7box.F
3349!||====================================================================
3350 SUBROUTINE i20ass0(JLT ,CS_LOC,N1 ,N2 ,M1 ,
3351 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
3352 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
3353 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
3354 5 FY4 ,FZ4 ,A ,STIFN,STIF ,
3355 6 NRTS ,NIN,JTASK)
3356C-----------------------------------------------
3357C M o d u l e s
3358C-----------------------------------------------
3359 USE tri7box
3360C-----------------------------------------------
3361C I m p l i c i t T y p e s
3362C-----------------------------------------------
3363#include "implicit_f.inc"
3364C-----------------------------------------------
3365C G l o b a l P a r a m e t e r s
3366C-----------------------------------------------
3367#include "mvsiz_p.inc"
3368C-----------------------------------------------
3369C D u m m y A r g u m e n t s
3370C-----------------------------------------------
3371 INTEGER JLT, NRTS, NIN,
3372 + cs_loc(*),
3373 + n1(mvsiz),n2(mvsiz),m1(mvsiz),m2(mvsiz),jtask
3374 my_real
3375 . hs1(mvsiz),hs2(mvsiz),hm1(mvsiz),hm2(mvsiz),
3376 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
3377 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
3378 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
3379 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
3380 . a(3,*), stifn(*), stif(*)
3381C-----------------------------------------------
3382C L o c a l V a r i a b l e s
3383C-----------------------------------------------
3384 INTEGER I, J1,NODFI,ISHIFT
3385C-----------------------------------------------
3386C
3387 nodfi = nlskyfi(nin)
3388 ishift = nodfi*(jtask-1)
3389C
3390 DO i=1,jlt
3391 IF(cs_loc(i)<=nrts) THEN
3392 j1=n1(i)
3393 a(1,j1)=a(1,j1)+fx1(i)
3394 a(2,j1)=a(2,j1)+fy1(i)
3395 a(3,j1)=a(3,j1)+fz1(i)
3396 stifn(j1) = stifn(j1) + stif(i)*abs(hs1(i))
3397C
3398 j1=n2(i)
3399 a(1,j1)=a(1,j1)+fx2(i)
3400 a(2,j1)=a(2,j1)+fy2(i)
3401 a(3,j1)=a(3,j1)+fz2(i)
3402 stifn(j1) = stifn(j1) + stif(i)*abs(hs2(i))
3403 ELSE
3404 j1=n1(i)
3405 afie(nin)%P(1,j1+ishift)=afie(nin)%P(1,j1+ishift)+fx1(i)
3406 afie(nin)%P(2,j1+ishift)=afie(nin)%P(2,j1+ishift)+fy1(i)
3407 afie(nin)%P(3,j1+ishift)=afie(nin)%P(3,j1+ishift)+fz1(i)
3408 stnfie(nin)%P(j1+ishift) = stnfie(nin)%P(j1+ishift) + stif(i)*abs(hs1(i))
3409C
3410 j1=n2(i)
3411 afie(nin)%P(1,j1+ishift)=afie(nin)%P(1,j1+ishift)+fx2(i)
3412 afie(nin)%P(2,j1+ishift)=afie(nin)%P(2,j1+ishift)+fy2(i)
3413 afie(nin)%P(3,j1+ishift)=afie(nin)%P(3,j1+ishift)+fz2(i)
3414 stnfie(nin)%P(j1+ishift) = stnfie(nin)%P(j1+ishift) + stif(i)*abs(hs2(i))
3415 END IF
3416 END DO
3417C
3418 DO i=1,jlt
3419 j1=m1(i)
3420 a(1,j1)=a(1,j1)+fx3(i)
3421 a(2,j1)=a(2,j1)+fy3(i)
3422 a(3,j1)=a(3,j1)+fz3(i)
3423 stifn(j1) = stifn(j1) + stif(i)*abs(hm1(i))
3424C
3425 j1=m2(i)
3426 a(1,j1)=a(1,j1)+fx4(i)
3427 a(2,j1)=a(2,j1)+fy4(i)
3428 a(3,j1)=a(3,j1)+fz4(i)
3429 stifn(j1) = stifn(j1) + stif(i)*abs(hm2(i))
3430 ENDDO
3431C
3432 RETURN
3433 END
3434C
3435!||====================================================================
3436!|| i20ass05 ../engine/source/interfaces/int20/i20for3.F
3437!||--- called by ------------------------------------------------------
3438!|| i20for3e ../engine/source/interfaces/int20/i20for3.F
3439!||--- uses -----------------------------------------------------
3440!|| tri7box ../engine/share/modules/tri7box.F
3441!||====================================================================
3442 SUBROUTINE i20ass05(JLT ,CS_LOC,N1 ,N2 ,M1 ,
3443 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
3444 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
3445 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
3446 5 FY4 ,FZ4 ,A ,STIFN,NRTS ,
3447 6 K1 ,K2 ,K3 ,K4 ,C1 ,
3448 7 C2 ,C3 ,C4 ,VISCN,NIN ,JTASK )
3449C-----------------------------------------------
3450C M o d u l e s
3451C-----------------------------------------------
3452 USE tri7box
3453C-----------------------------------------------
3454C I m p l i c i t T y p e s
3455C-----------------------------------------------
3456#include "implicit_f.inc"
3457C-----------------------------------------------
3458C G l o b a l P a r a m e t e r s
3459C-----------------------------------------------
3460#include "mvsiz_p.inc"
3461C-----------------------------------------------
3462C D u m m y A r g u m e n t s
3463C-----------------------------------------------
3464 INTEGER JLT, NRTS, NIN,
3465 + cs_loc(*),
3466 + n1(mvsiz),n2(mvsiz),m1(mvsiz),m2(mvsiz),jtask
3467 my_real
3468 . hs1(mvsiz),hs2(mvsiz),hm1(mvsiz),hm2(mvsiz),
3469 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
3470 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
3471 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
3472 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
3473 . k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
3474 . c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),
3475 . a(3,*), stifn(*), viscn(*)
3476C-----------------------------------------------
3477C L o c a l V a r i a b l e s
3478C-----------------------------------------------
3479 INTEGER I, J1,NODFI,ISHIFT
3480C-----------------------------------------------
3481C
3482 nodfi = nlskyfi(nin)
3483 ishift = nodfi*(jtask-1)
3484C
3485 DO i=1,jlt
3486 IF(cs_loc(i)<=nrts) THEN
3487 j1=n1(i)
3488 a(1,j1)=a(1,j1)+fx1(i)
3489 a(2,j1)=a(2,j1)+fy1(i)
3490 a(3,j1)=a(3,j1)+fz1(i)
3491 stifn(j1)=stifn(j1)+k1(i)
3492 viscn(j1)=viscn(j1)+c1(i)
3493C
3494 j1=n2(i)
3495 a(1,j1)=a(1,j1)+fx2(i)
3496 a(2,j1)=a(2,j1)+fy2(i)
3497 a(3,j1)=a(3,j1)+fz2(i)
3498 stifn(j1)=stifn(j1)+k2(i)
3499 viscn(j1)=viscn(j1)+c2(i)
3500 ELSE
3501 j1=n1(i)
3502 afie(nin)%P(1,j1+ishift)=afie(nin)%P(1,j1+ishift)+fx1(i)
3503 afie(nin)%P(2,j1+ishift)=afie(nin)%P(2,j1+ishift)+fy1(i)
3504 afie(nin)%P(3,j1+ishift)=afie(nin)%P(3,j1+ishift)+fz1(i)
3505 stnfie(nin)%P(j1+ishift)=stnfie(nin)%P(j1+ishift)+k1(i)
3506 vscfie(nin)%P(j1+ishift)=vscfie(nin)%P(j1+ishift)+c1(i)
3507C
3508 j1=n2(i)
3509 afie(nin)%P(1,j1+ishift)=afie(nin)%P(1,j1+ishift)+fx2(i)
3510 afie(nin)%P(2,j1+ishift)=afie(nin)%P(2,j1+ishift)+fy2(i)
3511 afie(nin)%P(3,j1+ishift)=afie(nin)%P(3,j1+ishift)+fz2(i)
3512 stnfie(nin)%P(j1+ishift)=stnfie(nin)%P(j1+ishift)+k2(i)
3513 vscfie(nin)%P(j1+ishift)=vscfie(nin)%P(j1+ishift)+c2(i)
3514 END IF
3515 END DO
3516C
3517 DO i=1,jlt
3518 j1=m1(i)
3519 a(1,j1)=a(1,j1)+fx3(i)
3520 a(2,j1)=a(2,j1)+fy3(i)
3521 a(3,j1)=a(3,j1)+fz3(i)
3522 stifn(j1)=stifn(j1)+k3(i)
3523 viscn(j1)=viscn(j1)+c3(i)
3524C
3525 j1=m2(i)
3526 a(1,j1)=a(1,j1)+fx4(i)
3527 a(2,j1)=a(2,j1)+fy4(i)
3528 a(3,j1)=a(3,j1)+fz4(i)
3529 stifn(j1)=stifn(j1)+k4(i)
3530 viscn(j1)=viscn(j1)+c4(i)
3531 ENDDO
3532C
3533 RETURN
3534 END
3535C
3536!||====================================================================
3537!|| i20ass2 ../engine/source/interfaces/int20/i20for3.F
3538!||--- called by ------------------------------------------------------
3539!|| i20for3e ../engine/source/interfaces/int20/i20for3.F
3540!||--- calls -----------------------------------------------------
3541!|| ancmsg ../engine/source/output/message/message.F
3542!|| arret ../engine/source/system/arret.F
3543!||--- uses -----------------------------------------------------
3544!|| message_mod ../engine/share/message_module/message_mod.F
3545!|| tri7box ../engine/share/modules/tri7box.F
3546!||====================================================================
3547 SUBROUTINE i20ass2(JLT ,CS_LOC ,N1 ,N2 ,M1 ,
3548 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
3549 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
3550 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
3551 5 FY4 ,FZ4 ,FSKYI ,ISKY ,NISKYFIE,
3552 6 STIF ,NRTS ,NIN ,NOINT )
3553C-----------------------------------------------
3554C M o d u l e s
3555C-----------------------------------------------
3556 USE tri7box
3557 USE message_mod
3558C-----------------------------------------------
3559C I m p l i c i t T y p e s
3560C-----------------------------------------------
3561#include "implicit_f.inc"
3562#include "comlock.inc"
3563C-----------------------------------------------
3564C G l o b a l P a r a m e t e r s
3565C-----------------------------------------------
3566#include "mvsiz_p.inc"
3567C-----------------------------------------------
3568C C o m m o n B l o c k s
3569C-----------------------------------------------
3570#include "parit_c.inc"
3571C-----------------------------------------------
3572C D u m m y A r g u m e n t s
3573C-----------------------------------------------
3574 INTEGER JLT, NRTS,NISKYFIE,NIN,NOINT,
3575 + cs_loc(*),isky(*),
3576 + n1(mvsiz),n2(mvsiz),m1(mvsiz),m2(mvsiz)
3577 my_real
3578 . hs1(mvsiz),hs2(mvsiz),hm1(mvsiz),hm2(mvsiz),
3579 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
3580 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
3581 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
3582 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
3583 . fskyi(lskyi,nfskyi), stif(*)
3584C-----------------------------------------------
3585C L o c a l V a r i a b l e s
3586C-----------------------------------------------
3587 INTEGER I, J1, NISKYL1, NISKYL,IGP,IGM, NISKYFIEL
3588C
3589 niskyl1 = 0
3590 DO i = 1, jlt
3591 IF (hm1(i)/=zero) niskyl1 = niskyl1 + 1
3592 ENDDO
3593 DO i = 1, jlt
3594 IF (hm2(i)/=zero) niskyl1 = niskyl1 + 1
3595 ENDDO
3596
3597 igp = 0
3598 igm = 0
3599 DO i=1,jlt
3600 IF(cs_loc(i)<=nrts) THEN
3601 igp = igp+2
3602 ELSE
3603 igm = igm+1
3604 ENDIF
3605 ENDDO
3606
3607#include "lockon.inc"
3608 niskyl = nisky
3609 nisky = nisky + niskyl1 + igp
3610 niskyfiel = niskyfie
3611 niskyfie = niskyfie + igm
3612#include "lockoff.inc"
3613
3614 IF (niskyl+niskyl1+igp > lskyi) THEN
3615 CALL ancmsg(msgid=26,anmode=aninfo)
3616 CALL arret(2)
3617 ENDIF
3618 IF (niskyfiel+igm > nlskyfie(nin)) THEN
3619 CALL ancmsg(msgid=26,anmode=aninfo)
3620 CALL arret(2)
3621 ENDIF
3622C
3623 DO i=1,jlt
3624 IF(cs_loc(i)<=nrts) THEN
3625 niskyl = niskyl + 1
3626 fskyi(niskyl,1)=fx1(i)
3627 fskyi(niskyl,2)=fy1(i)
3628 fskyi(niskyl,3)=fz1(i)
3629 fskyi(niskyl,4)=stif(i)*abs(hs1(i))
3630 isky(niskyl) = n1(i)
3631C
3632 niskyl = niskyl + 1
3633 fskyi(niskyl,1)=fx2(i)
3634 fskyi(niskyl,2)=fy2(i)
3635 fskyi(niskyl,3)=fz2(i)
3636 fskyi(niskyl,4)=stif(i)*abs(hs2(i))
3637 isky(niskyl) = n2(i)
3638 ELSE
3639 niskyfiel = niskyfiel + 1
3640 fskyfie(nin)%P(1,niskyfiel)=fx1(i)
3641 fskyfie(nin)%P(2,niskyfiel)=fy1(i)
3642 fskyfie(nin)%P(3,niskyfiel)=fz1(i)
3643 fskyfie(nin)%P(4,niskyfiel)=stif(i)*abs(hs1(i))
3644 fskyfie(nin)%P(5,niskyfiel)=fx2(i)
3645 fskyfie(nin)%P(6,niskyfiel)=fy2(i)
3646 fskyfie(nin)%P(7,niskyfiel)=fz2(i)
3647 fskyfie(nin)%P(8,niskyfiel)=stif(i)*abs(hs2(i))
3648 iskyfie(nin)%P(niskyfiel) = cs_loc(i)-nrts
3649 END IF
3650 END DO
3651C
3652 DO i=1,jlt
3653 IF (hm1(i)/=zero) THEN
3654 niskyl = niskyl + 1
3655 fskyi(niskyl,1)=fx3(i)
3656 fskyi(niskyl,2)=fy3(i)
3657 fskyi(niskyl,3)=fz3(i)
3658 fskyi(niskyl,4)=stif(i)*abs(hm1(i))
3659 isky(niskyl) = m1(i)
3660 ENDIF
3661 ENDDO
3662 DO i=1,jlt
3663 IF (hm2(i)/=zero) THEN
3664 niskyl = niskyl + 1
3665 fskyi(niskyl,1)=fx4(i)
3666 fskyi(niskyl,2)=fy4(i)
3667 fskyi(niskyl,3)=fz4(i)
3668 fskyi(niskyl,4)=stif(i)*abs(hm2(i))
3669 isky(niskyl) = m2(i)
3670 ENDIF
3671 ENDDO
3672C
3673 RETURN
3674 END
3675C
3676!||====================================================================
3677!|| i20ass25 ../engine/source/interfaces/int20/i20for3.F
3678!||--- called by ------------------------------------------------------
3679!|| i20for3e ../engine/source/interfaces/int20/i20for3.F
3680!||--- calls -----------------------------------------------------
3681!|| ancmsg ../engine/source/output/message/message.F
3682!|| arret ../engine/source/system/arret.F
3683!||--- uses -----------------------------------------------------
3684!|| message_mod ../engine/share/message_module/message_mod.F
3685!|| tri7box ../engine/share/modules/tri7box.F
3686!||====================================================================
3687 SUBROUTINE i20ass25(JLT ,CS_LOC ,N1 ,N2 ,M1 ,
3688 2 M2 ,HS1 ,HS2 ,HM1 ,HM2 ,
3689 3 FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
3690 4 FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
3691 5 FY4 ,FZ4 ,ISKY ,NISKYFIE,NRTS ,
3692 6 K1 ,K2 ,K3 ,K4 ,C1 ,
3693 7 C2 ,C3 ,C4 ,NIN ,NOINT )
3694C-----------------------------------------------
3695C M o d u l e s
3696C-----------------------------------------------
3697 USE tri7box
3698 USE message_mod
3699C-----------------------------------------------
3700C I m p l i c i t T y p e s
3701C-----------------------------------------------
3702#include "implicit_f.inc"
3703#include "comlock.inc"
3704C-----------------------------------------------
3705C G l o b a l P a r a m e t e r s
3706C-----------------------------------------------
3707#include "mvsiz_p.inc"
3708C-----------------------------------------------
3709C C o m m o n B l o c k s
3710C-----------------------------------------------
3711#include "parit_c.inc"
3712C-----------------------------------------------
3713C D u m m y A r g u m e n t s
3714C-----------------------------------------------
3715 INTEGER JLT, NRTS,NISKYFIE,NIN,NOINT,
3716 + cs_loc(*),isky(*),
3717 + n1(mvsiz),n2(mvsiz),m1(mvsiz),m2(mvsiz)
3718 my_real
3719 . hs1(mvsiz),hs2(mvsiz),hm1(mvsiz),hm2(mvsiz),
3720 . fx1(mvsiz),fy1(mvsiz),fz1(mvsiz),
3721 . fx2(mvsiz),fy2(mvsiz),fz2(mvsiz),
3722 . fx3(mvsiz),fy3(mvsiz),fz3(mvsiz),
3723 . fx4(mvsiz),fy4(mvsiz),fz4(mvsiz),
3724 . k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
3725 . c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),
3726 . fskyi(lskyi,nfskyi)
3727C-----------------------------------------------
3728C L o c a l V a r i a b l e s
3729C-----------------------------------------------
3730 INTEGER I, J1, NISKYL1, NISKYL,IGP,IGM, NISKYFIEL
3731C
3732 niskyl1 = 0
3733 DO i = 1, jlt
3734 IF (hm1(i)/=zero) niskyl1 = niskyl1 + 1
3735 ENDDO
3736 DO i = 1, jlt
3737 IF (hm2(i)/=zero) niskyl1 = niskyl1 + 1
3738 ENDDO
3739
3740 igp = 0
3741 igm = 0
3742 DO i=1,jlt
3743 IF(cs_loc(i)<=nrts) THEN
3744 igp = igp+2
3745 ELSE
3746 igm = igm+1
3747 ENDIF
3748 ENDDO
3749
3750#include "lockon.inc"
3751 niskyl = nisky
3752 nisky = nisky + niskyl1 + igp
3753 niskyfiel = niskyfie
3754 niskyfie = niskyfie + igm
3755#include "lockoff.inc"
3756C
3757 IF (niskyl+niskyl1+igp > lskyi) THEN
3758 CALL ancmsg(msgid=26,anmode=aninfo)
3759 CALL arret(2)
3760 ENDIF
3761 IF (niskyfiel+igm > nlskyfie(nin)) THEN
3762 CALL ancmsg(msgid=26,anmode=aninfo)
3763 CALL arret(2)
3764 ENDIF
3765C
3766 DO i=1,jlt
3767 IF(cs_loc(i)<=nrts) THEN
3768 niskyl = niskyl + 1
3769 fskyi(niskyl,1)=fx1(i)
3770 fskyi(niskyl,2)=fy1(i)
3771 fskyi(niskyl,3)=fz1(i)
3772 fskyi(niskyl,4)=k1(i)
3773 fskyi(niskyl,5)=c1(i)
3774 isky(niskyl) = n1(i)
3775C
3776 niskyl = niskyl + 1
3777 fskyi(niskyl,1)=fx2(i)
3778 fskyi(niskyl,2)=fy2(i)
3779 fskyi(niskyl,3)=fz2(i)
3780 fskyi(niskyl,4)=k2(i)
3781 fskyi(niskyl,5)=c2(i)
3782 isky(niskyl) = n2(i)
3783 ELSE
3784 niskyfiel = niskyfiel + 1
3785 fskyfie(nin)%P(1,niskyfiel)=fx1(i)
3786 fskyfie(nin)%P(2,niskyfiel)=fy1(i)
3787 fskyfie(nin)%P(3,niskyfiel)=fz1(i)
3788 fskyfie(nin)%P(4,niskyfiel)=k1(i)
3789 fskyfie(nin)%P(5,niskyfiel)=c1(i)
3790 fskyfie(nin)%P(6,niskyfiel)=fx2(i)
3791 fskyfie(nin)%P(7,niskyfiel)=fy2(i)
3792 fskyfie(nin)%P(8,niskyfiel)=fz2(i)
3793 fskyfie(nin)%P(9,niskyfiel)=k2(i)
3794 fskyfie(nin)%P(10,niskyfiel)=c2(i)
3795 iskyfie(nin)%P(niskyfiel) = cs_loc(i)-nrts
3796 END IF
3797 END DO
3798C
3799 DO i=1,jlt
3800 IF (hm1(i)/=zero) THEN
3801 niskyl = niskyl + 1
3802 fskyi(niskyl,1)=fx3(i)
3803 fskyi(niskyl,2)=fy3(i)
3804 fskyi(niskyl,3)=fz3(i)
3805 fskyi(niskyl,4)=k3(i)
3806 fskyi(niskyl,5)=c3(i)
3807 isky(niskyl) = m1(i)
3808 ENDIF
3809 ENDDO
3810 DO i=1,jlt
3811 IF (hm2(i)/=zero) THEN
3812 niskyl = niskyl + 1
3813 fskyi(niskyl,1)=fx4(i)
3814 fskyi(niskyl,2)=fy4(i)
3815 fskyi(niskyl,3)=fz4(i)
3816 fskyi(niskyl,4)=k4(i)
3817 fskyi(niskyl,5)=c4(i)
3818 isky(niskyl) = m2(i)
3819 ENDIF
3820 ENDDO
3821C
3822 RETURN
3823 END
alpha
#define alpha
Definition eval.h:35
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
i20for3e
subroutine i20for3e(jlt, a, v, ibc, icodt, fsav, gap, fric, ms, visc, viscf, noint, itab, cs_loc, cm_loc, stiglo, stifn, stif, fskyi, isky, fcont, stfs, stfm, dt2t, hs1, hs2, hm1, hm2, n1, n2, m1, m2, ivis2, neltst, ityptst, nx, ny, nz, gapv, penise, penime, inacti, niskyfie, newfront, isecin, nstrf, secfcum, viscn, nlinsa, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, nin, n1l, n2l, m1l, m2l, daanc6, alphak, mskyi_sms, iskyi_sms, nsms, jtask, isensint, fsavparit, nisub, nft, h3d_data)
Definition i20for3.F:2414
i20for3c
subroutine i20for3c(nln, nlg, ms, dxanc, dvanc, stfa, weight, inacti, daanc6, stfac, penia, alphak, daanc, kmin)
Definition i20for3.F:2270
i20ass0
subroutine i20ass0(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, a, stifn, stif, nrts, nin, jtask)
Definition i20for3.F:3356
i20ass25
subroutine i20ass25(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, isky, niskyfie, nrts, k1, k2, k3, k4, c1, c2, c3, c4, nin, noint)
Definition i20for3.F:3694
i20ass05
subroutine i20ass05(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, a, stifn, nrts, k1, k2, k3, k4, c1, c2, c3, c4, viscn, nin, jtask)
Definition i20for3.F:3449
i20ass2
subroutine i20ass2(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fskyi, isky, niskyfie, stif, nrts, nin, noint)
Definition i20for3.F:3553
i20for3
subroutine i20for3(output, jlt, a, va, ibcc, icodt, fsav, gap, fric, ms, visc, viscf, noint, stfa, itab, cn_loc, stiglo, stifn, stif, fskyi, isky, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, fcont, ix1l, ix2l, ix3l, ix4l, nsvg, ivis2, neltst, ityptst, dt2t, gapv, inacti, index, niskyfi, kinet, newfront, isecin, nstrf, secfcum, x, xa, ce_loc, mfrot, ifq, frot_p, cand_fx, cand_fy, cand_fz, alpha0, ifpen, gapr, dxanc, nln, nlg, ibag, icontact, nsv, penis, penim, viscn, vxi, vyi, vzi, msi, kini, nin, nisub, lisub, addsubs, addsubm, lisubs, lisubm, fsavsub, cand_n, ilagm, icurv, nod_normal, fncont, ftcont, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, iadm, rcurvi, rcontact, acontact, pcontact, anglmi, padm, intth, phi, fthe, ftheskyi, daanc6, temp, tempi, rstif, iform, gap_s, igap, alphak, mskyi_sms, iskyi_sms, nsms, cmaj, jtask, isensint, fsavparit, nft, h3d_data)
Definition i20for3.F:73
i20mainf
subroutine i20mainf(output, timers, ipari, x, a, icodt, fsav, v, ms, dt2t, neltst, ityptst, itab, stifn, fskyi, isky, fcont, nin, lindmax, kinet, jtask, nb_jlt, nb_jlt_new, nb_stok_n, niskyfi, newfront, nstrf, secfcum, icontact, viscn, num_imp, ns_imp, ne_imp, ind_imp, fsavsub, nrtmdim, fsavbag, eminx, ixs, ixs16, ixs20, fncont, ftcont, iad_elem, fr_elem, rcontact, acontact, pcontact, temp, fthe, ftheskyi, pm, iparg, iad17, weight, niskyfie, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, mskyi_sms, iskyi_sms, nodnx_sms, npc, tf, intbuf_tab, fbsav6, isensint, dimfb, h3d_data, theaccfact)
Definition i20mainf.F:81
i20sms2e
subroutine i20sms2e(jlt, cs_loc, n1, n2, m1, m2, hs1, hs2, hm1, hm2, stif, nin, noint, mskyi_sms, iskyi_sms, nsms, k1, k2, k3, k4, c1, c2, c3, c4, nrts)
Definition i20sms2.F:39
i7ass0
subroutine i7ass0(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, a, stifn, nin, intth, phi, fthe, phi1, phi2, phi3, phi4, condn, condint, jtask, iform, nodadt_therm)
Definition i7ass3.F:718
i7ass35
subroutine i7ass35(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, i8a, i8stifn, i8viscn, ks, k1, k2, k3, k4, cs, c1, c2, c3, c4)
Definition i7ass3.F:507
i7ass3
subroutine i7ass3(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, i8a, i8stifn)
Definition i7ass3.F:332
i7ass2
subroutine i7ass2(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, fskyi, isky, niskyfi, nin, noint, intth, phi, ftheskyi, phi1, phi2, phi3, phi4, condnskyi, condint, iform, nodadt_therm)
Definition i7ass3.F:1150
i7ass05
subroutine i7ass05(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, a, stifn, viscn, ks, k1, k2, k3, k4, cs, c1, c2, c3, c4, nin, intth, phi, fthe, phi1, phi2, phi3, phi4, jtask, condn, condint, iform, nodadt_therm)
Definition i7ass3.F:936
i7ass25
subroutine i7ass25(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, fxi, fyi, fzi, fskyi, niskyfi, nin, ks, k1, k2, k3, k4, cs, c1, c2, c3, c4, isky, noint, intth, phi, ftheskyi, phi1, phi2, phi3, phi4, condnskyi, condint, iform, nodadt_therm)
Definition i7ass3.F:1478
i7curv
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)
Definition i7curv.F:443
i7sms2
subroutine i7sms2(jlt, ix1, ix2, ix3, ix4, nsvg, h1, h2, h3, h4, stif, nin, noint, mskyi_sms, iskyi_sms, nsms, kt, c, cf, dtmini, dti)
Definition i7sms2.F:40
ibcoff
subroutine ibcoff(ibc, icodt)
Definition ibcoff.F:44
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
h3d_mod
Definition h3d_mod.F:311
icontact_mod
Definition icontact_mod.F:34
message_mod
Definition message_mod.F:1257
tri7box::dxancfi
type(real_pointer2), dimension(:), allocatable dxancfi
Definition tri7box.F:473
tri7box::fskyfie
type(real_pointer2), dimension(:), allocatable fskyfie
Definition tri7box.F:459
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::iskyfie
type(int_pointer), dimension(:), allocatable iskyfie
Definition tri7box.F:480
tri7box::daanc6fi
type(r8_pointer3), dimension(:), allocatable daanc6fi
Definition tri7box.F:476
tri7box::penfi
type(real_pointer2), dimension(:), allocatable penfi
Definition tri7box.F:459
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449
tri7box::stnfie
type(real_pointer), dimension(:), allocatable stnfie
Definition tri7box.F:449
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::nsvfi
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
tri7box::afie
type(real_pointer2), dimension(:), allocatable afie
Definition tri7box.F:459
tri7box::nsvfie
type(int_pointer), dimension(:), allocatable nsvfie
Definition tri7box.F:440
tri7box::daanc6fie
type(r8_pointer3), dimension(:), allocatable daanc6fie
Definition tri7box.F:476
tri7box::vscfie
type(real_pointer), dimension(:), allocatable vscfie
Definition tri7box.F:449
tri7box::alphakfie
type(real_pointer), dimension(:), allocatable alphakfie
Definition tri7box.F:449
tri7box::itafie
type(int_pointer), dimension(:), allocatable itafie
Definition tri7box.F:440
tri7box::nlskyfie
integer, dimension(:), allocatable nlskyfie
Definition tri7box.F:512
tri7box::penfie
type(real_pointer2), dimension(:), allocatable penfie
Definition tri7box.F:459
tri7box::nlskyfi
integer, dimension(:), allocatable nlskyfi
Definition tri7box.F:512
tri7box::itafi
type(int_pointer), dimension(:), allocatable itafi
Definition tri7box.F:440
foat_to_6_float
subroutine foat_to_6_float(jft, jlt, f, f6)
Definition parit.F:226
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86