OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11for3.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!|| i11for3 ../engine/source/interfaces/int11/i11for3.F
25!||--- called by ------------------------------------------------------
26!|| i11mainf ../engine/source/interfaces/int11/i11mainf.F
27!||--- calls -----------------------------------------------------
28!|| bitget ../engine/source/interfaces/intsort/i20sto.F
29!||--- uses -----------------------------------------------------
30!|| tri7box ../engine/share/modules/tri7box.F
31!||====================================================================
32 SUBROUTINE i11for3(
33 1 JLT ,FSAV ,GAP ,FRIC ,MS ,
34 2 VISC ,VISCF ,NOINT ,ITAB ,CS_LOC ,
35 3 CM_LOC ,STIF ,DT2T ,HS1 ,HS2 ,
36 4 HM1 ,HM2 ,N1 ,N2 , M1 ,
37 5 M2 ,IVIS2 ,NELTST ,ITYPTST ,NX ,
38 6 NY ,NZ ,GAPV ,PENIS ,PENIM ,
39 7 INACTI ,NEWFRONT ,NRTS ,MS1 ,MS2 ,
40 8 MM1 ,MM2 ,VXS1 ,VYS1 ,VZS1 ,
41 9 VXS2 ,VYS2 ,VZS2 ,VXM1 ,VYM1 ,
42 A VZM1 ,VXM2 ,VYM2 ,VZM2 ,NIN ,
43 B DTMINI ,IFORM ,CAND_FX ,CAND_FY ,CAND_FZ ,
44 C INDEX ,IFPEN ,STFS ,FNI ,
45 E FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
46 F FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
47 G FY4 ,FZ4 ,K1 ,K2 ,K3 ,
48 H K4 ,C1 ,C2 ,C3 ,C4 ,
49 I INTTH ,DRAD ,PENRAD ,ISENSINT,FSAVPARIT,
50 J NISUB ,NFT ,ADDSUBS ,ADDSUBM ,LISUBS ,
51 K LISUBM ,LISUB ,FSAVSUB ,FRICC ,VISCFFRIC,
52 L TAGNCONT ,KLOADPINTER,LOADPINTER,LOADP_HYD_INTER,
53 M TYPSUB ,INFLG_SUBS ,INFLG_SUBM,NINLOADP ,
54 N DGAPLOADINT,S_LOADPINTER )
55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE tri7box
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63#include "comlock.inc"
64C-----------------------------------------------
65C G l o b a l P a r a m e t e r s
66C-----------------------------------------------
67#include "mvsiz_p.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "com01_c.inc"
72#include "com04_c.inc"
73#include "com06_c.inc"
74#include "com08_c.inc"
75#include "scr05_c.inc"
76#include "scr07_c.inc"
77#include "scr11_c.inc"
78#include "scr18_c.inc"
79#include "units_c.inc"
80#include "impl1_c.inc"
81#include "sms_c.inc"
82#include "param_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER NELTST,ITYPTST,JLT,IBC,IVIS2,INACTI,NRTS,NIN,INTTH
87 INTEGER ITAB(*),
88 . NOINT,NEWFRONT,NISUB,NFT
89 INTEGER N1(MVSIZ), N2(MVSIZ), M1(MVSIZ), M2(MVSIZ),
90 . CS_LOC(MVSIZ), CM_LOC(MVSIZ),
91 . NSMS(MVSIZ),IFORM,INDEX(*),IFPEN(*), ISENSINT(*),
92 . ADDSUBS(*),ADDSUBM(*),LISUBS(*),LISUBM(*),LISUB(*),
93 . TAGNCONT(NLOADP_HYD_INTER,NUMNOD),
94 . TYPSUB(*),INFLG_SUBS(*), INFLG_SUBM(*)
95 INTEGER , INTENT(IN) :: NINLOADP,S_LOADPINTER
96 INTEGER , INTENT(IN) :: KLOADPINTER(NINTER+1),LOADPINTER(S_LOADPINTER),
97 . LOADP_HYD_INTER(NLOADP_HYD)
98 my_real
99 . MS(*), FSAV(*),
100 . STFS(*),GAPV(*),
101 . PENIS(2,*), PENIM(2,*),
102 . GAP, FRIC,VISC,VISCF,VIS,DT2T,DTMINI,DRAD
103 my_real
104 . HS1(MVSIZ), HS2(MVSIZ), HM1(MVSIZ), HM2(MVSIZ),
105 . NX(MVSIZ), NY(MVSIZ), NZ(MVSIZ), STIF(MVSIZ),
106 . MS1(MVSIZ),MS2(MVSIZ),MM1(MVSIZ),MM2(MVSIZ),
107 . VXS1(MVSIZ),VYS1(MVSIZ),VZS1(MVSIZ),VXS2(MVSIZ),VYS2(MVSIZ),
108 . vzs2(mvsiz),vxm1(mvsiz),vym1(mvsiz),vzm1(mvsiz),vxm2(mvsiz),
109 . vym2(mvsiz),vzm2(mvsiz),cand_fx(*),cand_fy(*),
110 . cand_fz(*),fni(*),
111 . fx1(mvsiz), fx2(mvsiz), fx3(mvsiz), fx4(mvsiz),
112 . fy1(mvsiz), fy2(mvsiz), fy3(mvsiz), fy4(mvsiz),
113 . fz1(mvsiz), fz2(mvsiz), fz3(mvsiz), fz4(mvsiz),
114 . k1(mvsiz),k2(mvsiz),k3(mvsiz),k4(mvsiz),
115 . c1(mvsiz),c2(mvsiz),c3(mvsiz),c4(mvsiz),penrad(mvsiz),
116 . fsavparit(nisub+1,11,*),fsavsub(nthvki,*),fricc(mvsiz),
117 . viscffric(mvsiz)
118 my_real , INTENT(IN) :: dgaploadint(s_loadpinter)
119 INTEGER BITGET
120 EXTERNAL bitget
121C-----------------------------------------------
122C L o c a l V a r i a b l e s
123C-----------------------------------------------
124 INTEGER I, J1, J , K0,NBINTER,K1S,K, NI
125 INTEGER NISKYL,NISKYL1,IDTM,IM,IS,JSUB,KSUB,JJ,KK,NSUB,PP,PPL,
126 . ITYPSUB,ISS1,ISS2,IMS1,IMS2
127 my_real
128 . VX(MVSIZ), VY(MVSIZ), VZ(MVSIZ), VN(MVSIZ),
129 . FXI(MVSIZ), FYI(MVSIZ), FZI(MVSIZ),
130
131 . PENE(MVSIZ),MASMIN(MVSIZ),
132 . VIS2(MVSIZ), DTMI(MVSIZ),
133 . VNX, VNY, VNZ, AA, VMAX,S2,DIST,RDIST,
134 . V2, FM2, DT1INV, VISCA, FAC, FF,
135 . FX, FY, FZ, F2, MAS2, DTI,
136 . FACM1, ECONTT, ECONVT, A2,MASM,ECONTDT,
137 . FSAV1, FSAV2, FSAV3, FSAV4, FSAV5, FSAV6,
138 . FSAV8, FSAV9, FSAV10, FSAV11, FSAV12,
139 . FSAV13, FSAV14, FSAV15, DTI2, PPLUS,DTMI0
140 my_real prec,beta,dgapload,gapp
141 my_real
142 . st1(mvsiz),st2(mvsiz),st3(mvsiz),st4(mvsiz),
143 . kt(mvsiz),c(mvsiz),cf(mvsiz),
144 . cx,cy,cfi,aux,dtm,ft,fn,ftn,fxt(mvsiz),fyt(mvsiz),
145 . fzt(mvsiz)
146C-----------------------------------------------
147 IF (iresp == 1) THEN
148 prec = fiveem4
149 ELSE
150 prec = em10
151 ENDIF
152 IF(dt1>zero)THEN
153 dt1inv = one/dt1
154 ELSE
155 dt1inv =zero
156 ENDIF
157 econtt = zero
158 econvt = zero
159 econtdt = zero
160C
161 IF(intth/=0.OR.ninloadp/=0 )THEN
162 DO i=1,jlt
163C RADIATION DISTANCE
164 dist = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
165 penrad(i)=dist-gapv(i)
166 ENDDO
167 ENDIF
168C
169 DO i=1,jlt
170 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
171 pene(i) = max(zero,gapv(i) - s2)
172 s2 = one/max(em30,s2)
173 nx(i) = nx(i)*s2
174 ny(i) = ny(i)*s2
175 nz(i) = nz(i)*s2
176 ENDDO
177C
178 IF(inacti==5)THEN
179#include "lockon.inc"
180 DO i=1,jlt
181 IF(cs_loc(i)<=nrts) THEN
182 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),half*pene(i))
183 ELSE
184 ni = cs_loc(i)-nrts
185 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),half*pene(i))
186 END IF
187 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),half*pene(i))
188 ENDDO
189#include "lockoff.inc"
190 DO i=1,jlt
191 IF(cs_loc(i)<=nrts) THEN
192 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
193 pene(i) = max(pene(i),zero)
194 IF(pene(i)==zero)stif(i)=zero
195 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
196 ELSE
197 ni = cs_loc(i)-nrts
198 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
199 pene(i) = max(pene(i),zero)
200 IF(pene(i)==zero)stif(i)=zero
201 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
202 END IF
203 END DO
204 ELSE IF(inacti==6)THEN
205#include "lockon.inc"
206 DO i=1,jlt
207 pplus=half*(pene(i)+fiveem2*(gapv(i)-pene(i)))
208 IF(cs_loc(i)<=nrts) THEN
209 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),pplus)
210 ELSE
211 ni = cs_loc(i)-nrts
212 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),pplus)
213 END IF
214 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),pplus)
215 ENDDO
216#include "lockoff.inc"
217 DO i=1,jlt
218 IF(cs_loc(i)<=nrts) THEN
219 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
220 pene(i) = max(pene(i),zero)
221 IF(pene(i)==zero)stif(i)=zero
222 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
223 ELSE
224 ni = cs_loc(i)-nrts
225 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
226 pene(i) = max(pene(i),zero)
227 IF(pene(i)==zero)stif(i)=zero
228 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
229 END IF
230 END DO
231 ELSE
232 DO i=1,jlt
233 IF( pene(i)==zero ) stif(i) = zero
234 ENDDO
235 ENDIF
236
237 vmax = zero
238 DO i=1,jlt
239 gapv(i) = zep9*gapv(i)
240 vx(i) = hs1(i)*vxs1(i) + hs2(i)*vxs2(i)
241 . - hm1(i)*vxm1(i) - hm2(i)*vxm2(i)
242 vy(i) = hs1(i)*vys1(i) + hs2(i)*vys2(i)
243 . - hm1(i)*vym1(i) - hm2(i)*vym2(i)
244 vz(i) = hs1(i)*vzs1(i) + hs2(i)*vzs2(i)
245 . - hm1(i)*vzm1(i) - hm2(i)*vzm2(i)
246 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
247 ENDDO
248C-------------------------------------------
249 DO i=1,jlt
250 fac = gapv(i)/max( em10,( gapv(i)-pene(i) ) )
251 facm1 = one/fac
252 IF(( (gapv(i)-pene(i))/gapv(i) )<prec .AND.
253 . stif(i)>zero ) THEN
254 stif(i) = zero
255 IF (impl_s==0) THEN
256 newfront = -1
257#include "lockon.inc"
258 IF(cs_loc(i)<=nrts)THEN
259 stfs(cs_loc(i)) = -abs(stfs(cs_loc(i)))
260 WRITE(istdo,*)'WARNING INTERFACE NB',noint
261 WRITE(istdo,*)'LINE ',itab(n1(i)),
262 . itab(n2(i)),'DE-ACTIVATED FROM','INTERFACE'
263 WRITE(iout,*)'WARNING INTERFACE NB',noint
264 WRITE(iout,*)'GAP=',gapv(i),'PENE=',pene(i)
265 WRITE(iout,*)'LINE ',itab(n1(i)),
266 . itab(n2(i)),'DE-ACTIVATED FROM','INTERFACE'
267 ELSE
268 ni = cs_loc(i)-nrts
269 stifi(nin)%P(ni) = -abs(stifi(nin)%P(ni))
270 WRITE(istdo,*)'WARNING INTERFACE NB',noint
271 WRITE(istdo,*)'LINE ',itafi(nin)%P(n1(i)),
272 . itafi(nin)%P(n2(i)),'DE-ACTIVATED FROM','INTERFACE'
273 WRITE(iout,*)'WARNING INTERFACE NB',noint
274 WRITE(iout,*)'GAP=',gapv(i),'PENE=',pene(i)
275 WRITE(iout,*)'LINE ',itafi(nin)%P(n1(i)),
276 . itafi(nin)%P(n2(i)),'DE-ACTIVATED FROM','INTERFACE'
277 END IF
278#include "lockoff.inc"
279 ENDIF
280 pene(i)= zero
281 ENDIF
282 econtt = econtt + half*stif(i)*gapv(i)**2 *( facm1 - one -
283 . log(facm1) )
284 stif(i) = half*stif(i) * fac
285 fni(i)= -stif(i) * pene(i)
286 ENDDO
287
288 dti = ep20
289C
290 DO i=1,jlt
291 dist=gapv(i)-pene(i)
292 rdist = half*dist / max(em30,-vn(i))
293 dti = min(rdist,dti)
294 ENDDO
295
296C Mix with global settings
297C IF (IDTMIN(10)==0) THEN
298C IDTM=2
299C ELSE
300C IDTM=IDTMIN(10)
301C END IF
302C IF (DTMINI>ZERO) THEN
303C DTM=DTMINI
304C ELSE
305C DTM=DTMIN1(10)
306C END IF
307
308C Force to DEL
309 IF (dtmini>zero) THEN
310 dtm=dtmini
311 idtm=2
312 ELSE
313 dtm=dtmin1(10)
314 idtm=idtmin(10)
315 END IF
316C
317 IF(dti<=dtm)THEN
318 DO i=1,jlt
319 dist=gapv(i)-pene(i)
320 dti2 = half*dist / max(em30,-vn(i))
321 IF(dti2<=dtm)THEN
322#include "lockon.inc"
323 IF(cs_loc(i)<=nrts)THEN
324 WRITE(iout,'(A,E12.4,A,I10,A,E12.4,A)')
325 . ' **WARNING MINIMUM TIME STEP ',dti2,
326 . 'IN INTERFACE NB',noint,'(DTMIN=',dtm,')'
327 WRITE(iout,*)'secondary nodes nb',ITAB(N1(I)),
328 . ITAB(N2(I))
329 WRITE(IOUT,*)'main nodes nb',ITAB(M1(I)),
330 . ITAB(M2(I))
331 ELSE
332 WRITE(IOUT,'(a,e12.4,a,i10,a,e12.4,a)')
333 . ' **warning minimum time step ',DTI2,
334 . 'in INTERFACE nb',NOINT,'(dtmin=',DTM,')'
335 WRITE(IOUT,*)'secondary nodes nb',ITAFI(NIN)%P(N1(I)),
336 . ITAFI(NIN)%P(N2(I))
337 WRITE(IOUT,*)'main nodes nb',ITAB(M1(I)),
338 . ITAB(M2(I))
339 END IF
340#include "lockoff.inc"
341 IF(IDTM==1)THEN
342 TSTOP = TT
343 ELSEIF(IDTM==2)THEN
344#include "lockon.inc"
345 WRITE(IOUT,*)'remove secondary line from interface'
346 IF(CS_LOC(I)<=NRTS)THEN
347 STFS(CS_LOC(I)) = -ABS(STFS(CS_LOC(I)))
348 ELSE
349 NI = CS_LOC(I)-NRTS
350 STIFI(NIN)%P(NI) = -ABS(STIFI(NIN)%P(NI))
351 END IF
352#include "lockoff.inc"
353 NEWFRONT = -1
354 STIF(I) = ZERO
355 DTI = DTM
356 ELSEIF(IDTM==5)THEN
357 MSTOP = 2
358 ENDIF
359 ENDIF
360 ENDDO
361 ENDIF
362C
363 IF(DTI<DT2T)THEN
364 DT2T = DTI
365 NELTST = NOINT
366 ITYPTST = 10
367 ENDIF
368C---------------------------------
369C DAMPING + FRIC
370C---------------------------------
371 IF(VISC/=ZERO)THEN
372 DO I=1,JLT
373 MAS2 = MS1(I)*HS1(I)
374 . + MS2(I)*HS2(I)
375 MASM = MM1(I)*HM1(I)
376 . + MM2(I)*HM2(I)
377 MASMIN(I) = MIN(MAS2,MASM)
378 VIS2(I) = TWO * STIF(I) * MIN(MAS2,MASM)
379 ENDDO
380 ELSE
381 DO I=1,JLT
382 IF(VISCFFRIC(I)/=ZERO) THEN
383 MAS2 = MS1(I)*HS1(I)
384 . + MS2(I)*HS2(I)
385 MASM = MM1(I)*HM1(I)
386 . + MM2(I)*HM2(I)
387 MASMIN(I) = MIN(MAS2,MASM)
388 VIS2(I) = TWO * STIF(I) * MIN(MAS2,MASM)
389 ENDIF
390 ENDDO
391 ENDIF
392
393C---------------------------------
394 IF(VISC/=ZERO)THEN
395.OR. IF(IVIS2==0IVIS2==1)THEN
396C---------------------------------
397C VISC QUAD TYPE V227
398C---------------------------------
399 DO I=1,JLT
400 IF(VN(I)<ZERO)
401 . VIS2(I) = VIS2(I)/(MAX(EM10,(GAPV(I)-PENE(I))/GAPV(I)))
402 ENDDO
403C---------------------------------
404 VISCA = ZEP4
405.AND..AND. IF(KDTINT==0(IDTMINS/=2IDTMINS_INT==0))THEN
406 DO I=1,JLT
407 FAC = STIF(I) / MAX(EM30,STIF(I))
408 VIS = SQRT(VIS2(I))
409 FF = FAC * (
410 . VISC * VIS +
411 . VISCA**2 * TWO * MASMIN(I) * MAX(ZERO,-VN(I)) /
412 . MAX((GAPV(I) - PENE(I)),EM10) )
413 STIF(I) = STIF(I) * GAPV(I)/MAX((GAPV(I)-PENE(I)),EM10)
414 STIF(I) = STIF(I) + FF * DT1INV
415 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCFFRIC(I))*VIS*DT1INV)
416 FF = MIN(FF * VN(I),-FNI(I))
417c FF = MIN(FF * VN(I),ZERO)
418 FNI(I) = FNI(I) + FF
419cc ECONVT = ECONVT + FF * VN(I) * DT1
420 ENDDO
421
422 ELSE
423 DO I=1,JLT
424 FAC = STIF(I) / MAX(EM30,STIF(I))
425 VIS = SQRT(VIS2(I))
426 C(I)= FAC * (
427 . VISC * VIS +
428 . VISCA**2 * TWO * MASMIN(I) * MAX(ZERO,-VN(I)) /
429 . MAX((GAPV(I) - PENE(I)),EM10) )
430 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I) - PENE(I)),EM10)
431 KT(I) = STIF(I)
432 STIF(I) = STIF(I) + C(I) * DT1INV
433 FF = MIN(C(I) * VN(I),-FNI(I))
434c FF = MIN(FF * VN(I),ZERO)
435 FNI(I) = FNI(I) + FF
436 CF(I) = FAC*SQRT(VISCFFRIC(I))*VIS
437 STIF(I) = MAX(STIF(I) ,CF(I)*DT1INV)
438cc ECONVT = ECONVT + C(I) * VN(I) * DT1
439 ENDDO
440 ENDIF
441
442 ELSEIF(IVIS2==2)THEN
443C---------------------------------
444C VISC QUAD TYPE
445C---------------------------------
446 DO I=1,JLT
447 VIS2(I) = VIS2(I)/( MAX(EM10,(GAPV(I)-PENE(I))/GAPV(I)))
448 ENDDO
449C---------------------------------
450 VISCA = HALF
451 DO I=1,JLT
452 FAC = STIF(I) / MAX(EM30,STIF(I))
453 VIS = SQRT(VIS2(I))
454 FF = FAC * (
455 . VISC * VIS +
456 . VISCA**2 * TWO * MASMIN(I) * ABS(VN(I)) /
457 . MAX((GAPV(I) - PENE(I)),EM10) )
458 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I)-PENE(I)),EM10)
459 STIF(I) = STIF(I) + TWO * FF * DT1INV
460 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCFFRIC(I))*VIS*DT1INV)
461 FF = MIN(FF * VN(I),-FNI(I))
462 FNI(I) = FNI(I) + FF
463 ENDDO
464 ELSEIF(IVIS2==3)THEN
465C---------------------------------
466C VISC QUAD = 0
467C---------------------------------
468 DO I=1,JLT
469 FAC = STIF(I) / MAX(EM30,STIF(I))
470 VIS = SQRT(VIS2(I))
471 FF = FAC * ( VISC * VIS ) /
472 . MAX((GAPV(I) - PENE(I)),EM10)
473 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I)-PENE(I)),EM10)
474 STIF(I) = STIF(I) + TWO * FF * DT1INV
475 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCFFRIC(I))*VIS*DT1INV)
476 FF = MIN(FF * VN(I),-FNI(I))
477 FNI(I) = FNI(I) + FF
478 ENDDO
479 ELSEIF(IVIS2==4)THEN
480C---------------------------------
481C VISC = 0
482C---------------------------------
483 DO I=1,JLT
484 VIS = SQRT(VIS2(I))
485 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I)-PENE(I)),EM10)
486 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCFFRIC(I))*VIS*DT1INV)
487 ENDDO
488 ELSEIF(IVIS2==5)THEN
489C---------------------------------
490C VISC = 2M/dt => pour visc < 1 , stable : dt < 2M/visc = dt
491C M=M1*M2/M1+M2 pour visc = 1 , choc elastique
492C pour visc = 0.5 , choc mou
493C---------------------------------
494 DO I=1,JLT
495 MAS2 = MS1(I)*HS1(I)
496 . + MS2(I)*HS2(I)
497 MASM = MM1(I)*HM1(I)
498 . + MM2(I)*HM2(I)
499 VIS = 2. * VISC * DT1INV * MASM * MAS2 /
500 . MAX(EM30,MASM+MAS2)
501 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I) -PENE(I)),EM10)
502 STIF(I) = MAX(STIF(I) ,FAC*SQRT(VISCFFRIC(I)*VIS2(I))*DT1INV)
503 FF = VIS * VN(I)
504 ECONTDT = ECONTDT + MIN(ZERO,FF-FNI(I)) * VN(I) * DT1
505 FNI(I) = MIN(FNI(I),FF)
506 ENDDO
507 ELSE
508 ENDIF
509 ELSE
510 DO I=1,JLT
511 STIF(I) = STIF(I) * GAPV(I) / MAX((GAPV(I) - PENE(I)),EM10)
512 ENDDO
513 ENDIF
514C---------------------------------
515C SAUVEGARDE DE L'IMPULSION NORMALE
516C---------------------------------
517 FSAV1 = ZERO
518 FSAV2 = ZERO
519 FSAV3 = ZERO
520 FSAV8 = ZERO
521 FSAV9 = ZERO
522 FSAV10= ZERO
523 FSAV11= ZERO
524 DO I=1,JLT
525 FXI(I)=NX(I)*FNI(I)
526 FYI(I)=NY(I)*FNI(I)
527 FZI(I)=NZ(I)*FNI(I)
528 FSAV1=FSAV1+FXI(I)*DT12
529 FSAV2=FSAV2+FYI(I)*DT12
530 FSAV3=FSAV3+FZI(I)*DT12
531 FSAV8=FSAV8+ABS(FXI(I)*DT12)
532 FSAV9=FSAV9+ABS(FYI(I)*DT12)
533 FSAV10=FSAV10+ABS(FZI(I)*DT12)
534 FSAV11=FSAV11+ABS(FNI(I))*DT12
535 ENDDO
536 IF (INCONV==1) THEN
537#include "lockon.inc"
538 FSAV(1)=FSAV(1)+FSAV1
539 FSAV(2)=FSAV(2)+FSAV2
540 FSAV(3)=FSAV(3)+FSAV3
541 FSAV(8)=FSAV(8)+FSAV8
542 FSAV(9)=FSAV(9)+FSAV9
543 FSAV(10)=FSAV(10)+FSAV10
544 FSAV(11)=FSAV(11)+FSAV11
545#include "lockoff.inc"
546 ENDIF
547C
548 IF(ISENSINT(1)/=0) THEN
549 DO I=1,JLT
550 FSAVPARIT(1,1,I+NFT) = FXI(I)
551 FSAVPARIT(1,2,I+NFT) = FYI(I)
552 FSAVPARIT(1,3,I+NFT) = FZI(I)
553 ENDDO
554 ENDIF
555C
556C impulsion normale pour les sous-interfaces
557C
558 IF (NISUB > 0) THEN
559C
560 DO I=1,JLT
561 IM=CM_LOC(I)
562 KK =ADDSUBM(IM)
563 IF (CS_LOC(I)<=NRTS) THEN
564C-- SECONDARY line on the proc
565 IS=CS_LOC(I)
566 JJ =ADDSUBS(IS)
567 DO WHILE(JJ<ADDSUBS(IS+1))
568 JSUB=LISUBS(JJ)
569 ITYPSUB = TYPSUB(JSUB)
570
571 IF(ITYPSUB == 1 ) THEN ! Defining specific inter
572
573 KSUB=LISUBM(KK)
574
575.AND. DO WHILE((KSUB<=JSUB)(KK<ADDSUBM(IM+1)))
576C
577 IF(KSUB==JSUB)THEN
578C
579 FSAV1=FXI(I)*DT12
580 FSAV2=FYI(I)*DT12
581 FSAV3=FZI(I)*DT12
582 FSAV8=ABS(FXI(I)*DT12)
583 FSAV9=ABS(FYI(I)*DT12)
584 FSAV10=ABS(FZI(I)*DT12)
585 FSAV11=ABS(FNI(I))*DT12
586C
587 NSUB=LISUB(JSUB)
588 FSAVSUB(1,NSUB)=FSAVSUB(1,NSUB)+FSAV1
589 FSAVSUB(2,NSUB)=FSAVSUB(2,NSUB)+FSAV2
590 FSAVSUB(3,NSUB)=FSAVSUB(3,NSUB)+FSAV3
591 FSAVSUB(8,NSUB)=FSAVSUB(8,NSUB)+FSAV8
592 FSAVSUB(9,NSUB)=FSAVSUB(9,NSUB)+FSAV9
593 FSAVSUB(10,NSUB)=FSAVSUB(10,NSUB)+FSAV10
594 FSAVSUB(11,NSUB)=FSAVSUB(11,NSUB)+FSAV11
595C
596 IF(ISENSINT(JSUB+1)/=0) THEN
597 FSAVPARIT(JSUB+1,1,I+NFT) = FXI(I)
598 FSAVPARIT(JSUB+1,2,I+NFT) = FYI(I)
599 FSAVPARIT(JSUB+1,3,I+NFT) = FZI(I)
600 ENDIF
601C
602 END IF
603
604 KK=KK+1
605 KSUB=LISUBM(KK)
606 ENDDO
607 JJ=JJ+1
608
609 ELSEIF(ITYPSUB == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface : secondary side
610C
611 FSAV1=FXI(I)*DT12
612 FSAV2=FYI(I)*DT12
613 FSAV3=FZI(I)*DT12
614 FSAV8=ABS(FXI(I)*DT12)
615 FSAV9=ABS(FYI(I)*DT12)
616 FSAV10=ABS(FZI(I)*DT12)
617 FSAV11=ABS(FNI(I))*DT12
618C
619 NSUB=LISUB(JSUB)
620 FSAVSUB(1,NSUB)=FSAVSUB(1,NSUB)+FSAV1
621 FSAVSUB(2,NSUB)=FSAVSUB(2,NSUB)+FSAV2
622 FSAVSUB(3,NSUB)=FSAVSUB(3,NSUB)+FSAV3
623 FSAVSUB(8,NSUB)=FSAVSUB(8,NSUB)+FSAV8
624 FSAVSUB(9,NSUB)=FSAVSUB(9,NSUB)+FSAV9
625 FSAVSUB(10,NSUB)=FSAVSUB(10,NSUB)+FSAV10
626 FSAVSUB(11,NSUB)=FSAVSUB(11,NSUB)+FSAV11
627C
628 IF(ISENSINT(JSUB+1)/=0) THEN
629 FSAVPARIT(JSUB+1,1,I+NFT) = FXI(I)
630 FSAVPARIT(JSUB+1,2,I+NFT) = FYI(I)
631 FSAVPARIT(JSUB+1,3,I+NFT) = FZI(I)
632 ENDIF
633C
634
635 JJ=JJ+1
636 ELSEIF(ITYPSUB == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2 surfacec
637
638 ISS2 = BITGET(INFLG_SUBS(JJ),0)
639 ISS1 = BITGET(INFLG_SUBS(JJ),1)
640 KSUB=LISUBM(KK)
641.AND. DO WHILE((KSUB<=JSUB)(KK<ADDSUBM(IM+1)))
642 IMS2 = BITGET(INFLG_SUBM(KK),0)
643 IMS1 = BITGET(INFLG_SUBM(KK),1)
644 IF(KSUB==JSUB)THEN
645.NOT..AND..OR. IF(((IMS1 == 1 ISS2 == 1)
646.AND. . (IMS2 == 1 ISS1 == 1))) THEN
647 KK=KK+1
648 KSUB=LISUBM(KK)
649 CYCLE
650 END IF
651C
652 FSAV1=FXI(I)*DT12
653 FSAV2=FYI(I)*DT12
654 FSAV3=FZI(I)*DT12
655 FSAV8=ABS(FXI(I)*DT12)
656 FSAV9=ABS(FYI(I)*DT12)
657 FSAV10=ABS(FZI(I)*DT12)
658 FSAV11=ABS(FNI(I))*DT12
659C
660 NSUB=LISUB(JSUB)
661 IF(IMS2 > 0)THEN
662 FSAVSUB(1,NSUB)=FSAVSUB(1,NSUB)-FSAV1
663 FSAVSUB(2,NSUB)=FSAVSUB(2,NSUB)-FSAV2
664 FSAVSUB(3,NSUB)=FSAVSUB(3,NSUB)-FSAV3
665
666 ELSE
667 FSAVSUB(1,NSUB)=FSAVSUB(1,NSUB)+FSAV1
668 FSAVSUB(2,NSUB)=FSAVSUB(2,NSUB)+FSAV2
669 FSAVSUB(3,NSUB)=FSAVSUB(3,NSUB)+FSAV3
670 ENDIF
671 FSAVSUB(8,NSUB)=FSAVSUB(8,NSUB)+FSAV8
672 FSAVSUB(9,NSUB)=FSAVSUB(9,NSUB)+FSAV9
673 FSAVSUB(10,NSUB)=FSAVSUB(10,NSUB)+FSAV10
674 FSAVSUB(11,NSUB)=FSAVSUB(11,NSUB)+FSAV11
675C
676 IF(ISENSINT(JSUB+1)/=0) THEN
677 IF(IMS2 > 0)THEN
678 FSAVPARIT(JSUB+1,1,I+NFT) = -FXI(I)
679 FSAVPARIT(JSUB+1,2,I+NFT) = -FYI(I)
680 FSAVPARIT(JSUB+1,3,I+NFT) = -FZI(I)
681 ELSE
682 FSAVPARIT(JSUB+1,1,I+NFT) = FXI(I)
683 FSAVPARIT(JSUB+1,2,I+NFT) = FYI(I)
684 FSAVPARIT(JSUB+1,3,I+NFT) = FZI(I)
685 ENDIF
686 ENDIF
687C
688 END IF
689
690 KK=KK+1
691 KSUB=LISUBM(KK)
692 ENDDO
693 JJ=JJ+1
694
695 ENDIF
696
697 ENDDO
698
699 DO WHILE(KK<ADDSUBM(IM+1))
700 KSUB=LISUBM(KK)
701
702 ITYPSUB = TYPSUB(KSUB)
703 IF(ITYPSUB == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface : main side
704C
705 FSAV1=FXI(I)*DT12
706 FSAV2=FYI(I)*DT12
707 FSAV3=FZI(I)*DT12
708 FSAV8=ABS(FXI(I)*DT12)
709 FSAV9=ABS(FYI(I)*DT12)
710 FSAV10=ABS(FZI(I)*DT12)
711 FSAV11=ABS(FNI(I))*DT12
712C
713 NSUB=LISUB(KSUB)
714 FSAVSUB(1,NSUB)=FSAVSUB(1,NSUB)-FSAV1
715 FSAVSUB(2,NSUB)=FSAVSUB(2,NSUB)-FSAV2
716 FSAVSUB(3,NSUB)=FSAVSUB(3,NSUB)-FSAV3
717 FSAVSUB(8,NSUB)=FSAVSUB(8,NSUB)+FSAV8
718 FSAVSUB(9,NSUB)=FSAVSUB(9,NSUB)+FSAV9
719 FSAVSUB(10,NSUB)=FSAVSUB(10,NSUB)+FSAV10
720 FSAVSUB(11,NSUB)=FSAVSUB(11,NSUB)+FSAV11
721C
722 IF(ISENSINT(JSUB+1)/=0) THEN
723 FSAVPARIT(JSUB+1,1,I+NFT) = -FXI(I)
724 FSAVPARIT(JSUB+1,2,I+NFT) = -FYI(I)
725 FSAVPARIT(JSUB+1,3,I+NFT) = -FZI(I)
726 ENDIF
727C
728
729 ENDIF
730 KK=KK+1
731 ENDDO
732
733
734
735 ELSE
736C-- Remote SECONDARY line
737 IS=CS_LOC(I)-NRTS
738 JJ =ADDSUBSFI(NIN)%P(IS)
739 DO WHILE(JJ<ADDSUBSFI(NIN)%P(IS+1))
740 JSUB=LISUBSFI(NIN)%P(JJ)
741 ITYPSUB = TYPSUB(JSUB)
742
743 IF(ITYPSUB == 1 ) THEN ! Defining specific inter
744
745 KSUB=LISUBM(KK)
746.AND. DO WHILE((KSUB<=JSUB)(KK<ADDSUBM(IM+1)))
747C
748 IF(KSUB==JSUB)THEN
749C
750 FSAV1=FXI(I)*DT12
751 FSAV2=FYI(I)*DT12
752 FSAV3=FZI(I)*DT12
753 FSAV8=ABS(FXI(I)*DT12)
754 FSAV9=ABS(FYI(I)*DT12)
755 FSAV10=ABS(FZI(I)*DT12)
756 FSAV11=ABS(FNI(I))*DT12
757C
758 NSUB=LISUB(JSUB)
759 FSAVSUB(1,NSUB)=FSAVSUB(1,NSUB)+FSAV1
760 FSAVSUB(2,NSUB)=FSAVSUB(2,NSUB)+FSAV2
761 FSAVSUB(3,NSUB)=FSAVSUB(3,NSUB)+FSAV3
762 FSAVSUB(8,NSUB)=FSAVSUB(8,NSUB)+FSAV8
763 FSAVSUB(9,NSUB)=FSAVSUB(9,NSUB)+FSAV9
764 FSAVSUB(10,NSUB)=FSAVSUB(10,NSUB)+FSAV10
765 FSAVSUB(11,NSUB)=FSAVSUB(11,NSUB)+FSAV11
766C
767 IF(ISENSINT(JSUB+1)/=0) THEN
768 FSAVPARIT(JSUB+1,1,I+NFT) = FXI(I)
769 FSAVPARIT(JSUB+1,2,I+NFT) = FYI(I)
770 FSAVPARIT(JSUB+1,3,I+NFT) = FZI(I)
771 ENDIF
772C
773 END IF
774
775 KK=KK+1
776 KSUB=LISUBM(KK)
777 ENDDO
778 JJ=JJ+1
779
780 ELSEIF(ITYPSUB == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface
781C
782 FSAV1=FXI(I)*DT12
783 FSAV2=FYI(I)*DT12
784 FSAV3=FZI(I)*DT12
785 FSAV8=ABS(FXI(I)*DT12)
786 FSAV9=ABS(FYI(I)*DT12)
787 FSAV10=ABS(FZI(I)*DT12)
788 FSAV11=ABS(FNI(I))*DT12
789C
790 NSUB=LISUB(JSUB)
791 FSAVSUB(1,NSUB)=FSAVSUB(1,NSUB)+FSAV1
792 FSAVSUB(2,NSUB)=FSAVSUB(2,NSUB)+FSAV2
793 FSAVSUB(3,NSUB)=FSAVSUB(3,NSUB)+FSAV3
794 FSAVSUB(8,NSUB)=FSAVSUB(8,NSUB)+FSAV8
795 FSAVSUB(9,NSUB)=FSAVSUB(9,NSUB)+FSAV9
796 FSAVSUB(10,NSUB)=FSAVSUB(10,NSUB)+FSAV10
797 FSAVSUB(11,NSUB)=FSAVSUB(11,NSUB)+FSAV11
798C
799 IF(ISENSINT(JSUB+1)/=0) THEN
800 FSAVPARIT(JSUB+1,1,I+NFT) = FXI(I)
801 FSAVPARIT(JSUB+1,2,I+NFT) = FYI(I)
802 FSAVPARIT(JSUB+1,3,I+NFT) = FZI(I)
803 ENDIF
804C
805
806 JJ=JJ+1
807
808 ELSEIF(ITYPSUB == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2 surfacec
809
810 ISS2 = BITGET(INFLG_SUBSFI(NIN)%P(JJ),0)
811 ISS1 = BITGET(INFLG_SUBSFI(NIN)%P(JJ),1)
812 KSUB=LISUBM(KK)
813.AND. DO WHILE((KSUB<=JSUB)(KK<ADDSUBM(IM+1)))
814 IMS2 = BITGET(INFLG_SUBM(KK),0)
815 IMS1 = BITGET(INFLG_SUBM(KK),1)
816 IF(KSUB==JSUB)THEN
817.NOT..AND..OR. IF(((IMS1 == 1 ISS2 == 1)
818.AND. . (IMS2 == 1 ISS1 == 1))) THEN
819 KK=KK+1
820 KSUB=LISUBM(KK)
821 CYCLE
822 END IF
823C
824 FSAV1=FXI(I)*DT12
825 FSAV2=FYI(I)*DT12
826 FSAV3=FZI(I)*DT12
827 FSAV8=ABS(FXI(I)*DT12)
828 FSAV9=ABS(FYI(I)*DT12)
829 FSAV10=ABS(FZI(I)*DT12)
830 FSAV11=ABS(FNI(I))*DT12
831C
832 NSUB=LISUB(JSUB)
833 IF(IMS2 > 0)THEN
834 FSAVSUB(1,NSUB)=FSAVSUB(1,NSUB)-FSAV1
835 FSAVSUB(2,NSUB)=FSAVSUB(2,NSUB)-FSAV2
836 FSAVSUB(3,NSUB)=FSAVSUB(3,NSUB)-FSAV3
837
838 ELSE
839 FSAVSUB(1,NSUB)=FSAVSUB(1,NSUB)+FSAV1
840 FSAVSUB(2,NSUB)=FSAVSUB(2,NSUB)+FSAV2
841 FSAVSUB(3,NSUB)=FSAVSUB(3,NSUB)+FSAV3
842 ENDIF
843 FSAVSUB(8,NSUB)=FSAVSUB(8,NSUB)+FSAV8
844 FSAVSUB(9,NSUB)=FSAVSUB(9,NSUB)+FSAV9
845 FSAVSUB(10,NSUB)=FSAVSUB(10,NSUB)+FSAV10
846 FSAVSUB(11,NSUB)=FSAVSUB(11,NSUB)+FSAV11
847C
848 IF(ISENSINT(JSUB+1)/=0) THEN
849 IF(IMS2 > 0)THEN
850 FSAVPARIT(JSUB+1,1,I+NFT) = -FXI(I)
851 FSAVPARIT(JSUB+1,2,I+NFT) = -FYI(I)
852 FSAVPARIT(JSUB+1,3,I+NFT) = -FZI(I)
853 ELSE
854 FSAVPARIT(JSUB+1,1,I+NFT) = FXI(I)
855 FSAVPARIT(JSUB+1,2,I+NFT) = FYI(I)
856 FSAVPARIT(JSUB+1,3,I+NFT) = FZI(I)
857 ENDIF
858 ENDIF
859C
860 END IF
861
862 KK=KK+1
863 KSUB=LISUBM(KK)
864 ENDDO
865 JJ=JJ+1
866
867 ENDIF
868
869 ENDDO
870 ENDIF
871
872 ENDDO
873C
874 ENDIF
875
876C------------For /LOAD/PRESSURE tag nodes in contact-------------
877 IF(NINLOADP > 0) THEN
878 DO K = KLOADPINTER(NIN)+1, KLOADPINTER(NIN+1)
879 PP = LOADPINTER(K)
880 PPL = LOADP_HYD_INTER(PP)
881 DGAPLOAD = DGAPLOADINT(K)
882 DO I=1,JLT
883 DIST = PENRAD(I) + GAPV(I)
884 GAPP= GAPV(I) + DGAPLOAD
885.OR. IF(PENE(I) > ZERO DIST <= GAPP) THEN
886 TAGNCONT(PPL,M1(I)) = 1
887 TAGNCONT(PPL,M2(I)) = 1
888 IF(CS_LOC(I)<=NRTS) THEN
889C SPMD : do same after reception of forces for remote nodes
890 TAGNCONT(PPL,N1(I)) = 1
891 TAGNCONT(PPL,N2(I)) = 1
892 ENDIF
893 ENDIF
894 ENDDO
895 ENDDO
896 ENDIF
897C
898C---------------------------------
899C FRICTION
900C---------------------------------
901 IF(IFORM==1)THEN
902 FSAV4 = ZERO
903 FSAV5 = ZERO
904 FSAV6 = ZERO
905 FSAV12 = ZERO
906 FSAV13 = ZERO
907 FSAV14 = ZERO
908 FSAV15 = ZERO
909 DO I=1,JLT
910 IF(FRICC(I)*VISCFFRIC(I)/=0.)THEN
911 VNX = NX(I)*VN(I)
912 VNY = NY(I)*VN(I)
913 VNZ = NZ(I)*VN(I)
914 VX(I) = VX(I) - VNX
915 VY(I) = VY(I) - VNY
916 VZ(I) = VZ(I) - VNZ
917 V2 = VX(I)**2 + VY(I)**2 + VZ(I)**2
918 VIS2(I) = VISCFFRIC(I) * VIS2(I)
919 FM2 = (FRICC(I)*FNI(I))**2
920 F2 = VIS2(I) * V2
921 A2 = MIN(F2,FM2) / MAX(EM30,F2)
922 AA = SQRT(A2 * VIS2(I))
923 FXT(I) = AA * VX(I)
924 FYT(I) = AA * VY(I)
925 FZT(I) = AA * VZ(I)
926 FSAV4 = FSAV4 + FXT(I)*DT12
927 FSAV5 = FSAV5 + FYT(I)*DT12
928 FSAV6 = FSAV6 + FZT(I)*DT12
929 FXI(I)=FXI(I) + FXT(I)
930 FYI(I)=FYI(I) + FYT(I)
931 FZI(I)=FZI(I) + FZT(I)
932 FSAV12 = FSAV12 + ABS(FXI(I)*DT12)
933 FSAV13 = FSAV13 + ABS(FYI(I)*DT12)
934 FSAV14 = FSAV14 + ABS(FZI(I)*DT12)
935 FSAV15 = FSAV15 + SQRT(FXI(I)*FXI(I)+FYI(I)*FYI(I)+FZI(I)*FZI(I))*DT12
936 ECONVT = ECONVT + AA * V2 * DT1
937 ENDIF
938 ENDDO
939 IF (INCONV==1) THEN
940#include "lockon.inc"
941 FSAV(4) = FSAV(4) + FSAV4
942 FSAV(5) = FSAV(5) + FSAV5
943 FSAV(6) = FSAV(6) + FSAV6
944 FSAV(12) = FSAV(12) + FSAV12
945 FSAV(13) = FSAV(13) + FSAV13
946 FSAV(14) = FSAV(14) + FSAV14
947 FSAV(15) = FSAV(15) + FSAV15
948#include "lockoff.inc"
949 ENDIF
950 ELSEIF(IFORM==2)THEN
951C---------------------------------
952C INCREMENTAL (STIFFNESS) FORMULATION
953C---------------------------------
954 FSAV4 = ZERO
955 FSAV5 = ZERO
956 FSAV6 = ZERO
957 FSAV12 = ZERO
958 FSAV13 = ZERO
959 FSAV14 = ZERO
960 FSAV15 = ZERO
961 DO I=1,JLT
962 FX = STIF(I)*VX(I)*DT12
963 FY = STIF(I)*VY(I)*DT12
964 FZ = STIF(I)*VZ(I)*DT12
965 FX = CAND_FX(INDEX(I)) + FX
966 FY = CAND_FY(INDEX(I)) + FY
967 FZ = CAND_FZ(INDEX(I)) + FZ
968 FTN = FX*NX(I) + FY*NY(I) + FZ*NZ(I)
969 FX = FX - FTN*NX(I)
970 FY = FY - FTN*NY(I)
971 FZ = FZ - FTN*NZ(I)
972 FT = FX*FX + FY*FY + FZ*FZ
973 FT = MAX(FT,EM30)
974 FN = FXI(I)**2+FYI(I)**2+FZI(I)**2
975 BETA = MIN(ONE,FRICC(I)*SQRT(FN/FT))
976 FXT(I) = FX * BETA
977 FYT(I) = FY * BETA
978 FZT(I) = FZ * BETA
979 FSAV4 = FSAV4 + FXT(I)*DT12
980 FSAV5 = FSAV5 + FYT(I)*DT12
981 FSAV6 = FSAV6 + FZT(I)*DT12
982 CAND_FX(INDEX(I)) = FXT(I)
983 CAND_FY(INDEX(I)) = FYT(I)
984 CAND_FZ(INDEX(I)) = FZT(I)
985 IFPEN(INDEX(I)) = 1
986 FXI(I)=FXI(I) + FXT(I)
987 FYI(I)=FYI(I) + FYT(I)
988 FZI(I)=FZI(I) + FZT(I)
989 FSAV12 = FSAV12 + ABS(FXI(I)*DT12)
990 FSAV13 = FSAV13 + ABS(FYI(I)*DT12)
991 FSAV14 = FSAV14 + ABS(FZI(I)*DT12)
992 FSAV15 = FSAV15 + SQRT(FXI(I)*FXI(I)+FYI(I)*FYI(I)+FZI(I)*FZI(I))*DT12
993 ECONVT = ECONVT
994 . + DT1*(VX(I)*FXT(I)+VY(I)*FYT(I)+VZ(I)*FZT(I))
995 ENDDO
996 IF (INCONV==1) THEN
997#include "lockon.inc"
998 FSAV(4) = FSAV(4) + FSAV4
999 FSAV(5) = FSAV(5) + FSAV5
1000 FSAV(6) = FSAV(6) + FSAV6
1001 FSAV(12) = FSAV(12) + FSAV12
1002 FSAV(13) = FSAV(13) + FSAV13
1003 FSAV(14) = FSAV(14) + FSAV14
1004 FSAV(15) = FSAV(15) + FSAV15
1005#include "lockoff.inc"
1006 ENDIF
1007
1008 ENDIF
1009C
1010 IF(ISENSINT(1)/=0) THEN
1011 DO I=1,JLT
1012 FSAVPARIT(1,4,I+NFT) = FXT(I)
1013 FSAVPARIT(1,5,I+NFT) = FYT(I)
1014 FSAVPARIT(1,6,I+NFT) = FZT(I)
1015 ENDDO
1016 ENDIF
1017C
1018C
1019C impulsion tangentielle dans les sous-interfaces
1020C
1021 IF (NISUB > 0) THEN
1022C
1023 DO I=1,JLT
1024 IM=CM_LOC(I)
1025 KK =ADDSUBM(IM)
1026 IF (CS_LOC(I)<=NRTS) THEN
1027C-- SECONDARY line on the proc
1028 IS=CS_LOC(I)
1029 JJ =ADDSUBS(IS)
1030
1031 DO WHILE(JJ<ADDSUBS(IS+1))
1032 JSUB=LISUBS(JJ)
1033 ITYPSUB = TYPSUB(JSUB)
1034 IF(ITYPSUB == 1 ) THEN ! Defining specific inter
1035
1036 KSUB=LISUBM(KK)
1037.AND. DO WHILE((KSUB<=JSUB)(KK<ADDSUBM(IM+1)))
1038 IF(KSUB==JSUB)THEN
1039C
1040 FSAV4=FXT(I)*DT12
1041 FSAV5=FYT(I)*DT12
1042 FSAV6=FZT(I)*DT12
1043 FSAV12 = ABS(FXI(I)*DT12)
1044 FSAV13 = ABS(FYI(I)*DT12)
1045 FSAV14 = ABS(FZI(I)*DT12)
1046 FSAV15 = SQRT(FXI(I)*FXI(I)+FYI(I)*FYI(I)+FZI(I)*FZI(I))*DT12
1047C
1048 NSUB=LISUB(JSUB)
1049 FSAVSUB(4,NSUB)=FSAVSUB(4,NSUB)+FSAV4
1050 FSAVSUB(5,NSUB)=FSAVSUB(5,NSUB)+FSAV5
1051 FSAVSUB(6,NSUB)=FSAVSUB(6,NSUB)+FSAV6
1052 FSAVSUB(12,NSUB)=FSAVSUB(12,NSUB)+FSAV12
1053 FSAVSUB(13,NSUB)=FSAVSUB(13,NSUB)+FSAV13
1054 FSAVSUB(14,NSUB)=FSAVSUB(14,NSUB)+FSAV14
1055 FSAVSUB(15,NSUB)=FSAVSUB(15,NSUB)+FSAV15
1056C
1057 IF(ISENSINT(JSUB+1)/=0) THEN
1058 FSAVPARIT(JSUB+1,4,I+NFT) = FXT(I)
1059 FSAVPARIT(JSUB+1,5,I+NFT) = FYT(I)
1060 FSAVPARIT(JSUB+1,6,I+NFT) = FZT(I)
1061 ENDIF
1062 END IF
1063
1064 KK=KK+1
1065 KSUB=LISUBM(KK)
1066 ENDDO
1067 JJ=JJ+1
1068
1069 ELSEIF(ITYPSUB == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface
1070C
1071 FSAV4=FXT(I)*DT12
1072 FSAV5=FYT(I)*DT12
1073 FSAV6=FZT(I)*DT12
1074 FSAV12 = ABS(FXI(I)*DT12)
1075 FSAV13 = ABS(FYI(I)*DT12)
1076 FSAV14 = ABS(FZI(I)*DT12)
1077 FSAV15 = SQRT(FXI(I)*FXI(I)+FYI(I)*FYI(I)+FZI(I)*FZI(I))*DT12
1078C
1079 NSUB=LISUB(JSUB)
1080 FSAVSUB(4,NSUB)=FSAVSUB(4,NSUB)+FSAV4
1081 FSAVSUB(5,NSUB)=FSAVSUB(5,NSUB)+FSAV5
1082 FSAVSUB(6,NSUB)=FSAVSUB(6,NSUB)+FSAV6
1083 FSAVSUB(12,NSUB)=FSAVSUB(12,NSUB)+FSAV12
1084 FSAVSUB(13,NSUB)=FSAVSUB(13,NSUB)+FSAV13
1085 FSAVSUB(14,NSUB)=FSAVSUB(14,NSUB)+FSAV14
1086 FSAVSUB(15,NSUB)=FSAVSUB(15,NSUB)+FSAV15
1087C
1088 IF(ISENSINT(JSUB+1)/=0) THEN
1089 FSAVPARIT(JSUB+1,4,I+NFT) = FXT(I)
1090 FSAVPARIT(JSUB+1,5,I+NFT) = FYT(I)
1091 FSAVPARIT(JSUB+1,6,I+NFT) = FZT(I)
1092 ENDIF
1093C
1094 JJ = JJ + 1
1095 ELSEIF(ITYPSUB == 3) THEN
1096
1097 ISS2 = BITGET(INFLG_SUBS(JJ),0)
1098 ISS1 = BITGET(INFLG_SUBS(JJ),1)
1099 KSUB=LISUBM(KK)
1100.AND. DO WHILE((KSUB<=JSUB)(KK<ADDSUBM(IM+1)))
1101 IMS2 = BITGET(INFLG_SUBM(KK),0)
1102 IMS1 = BITGET(INFLG_SUBM(KK),1)
1103 IF(KSUB==JSUB)THEN
1104.NOT..AND..OR. IF(((IMS1 == 1 ISS2 == 1)
1105.AND. . (IMS2 == 1 ISS1 == 1))) THEN
1106 KK=KK+1
1107 KSUB=LISUBM(KK)
1108 CYCLE
1109 END IF
1110C
1111 FSAV4=FXT(I)*DT12
1112 FSAV5=FYT(I)*DT12
1113 FSAV6=FZT(I)*DT12
1114 FSAV12 = ABS(FXI(I)*DT12)
1115 FSAV13 = ABS(FYI(I)*DT12)
1116 FSAV14 = ABS(FZI(I)*DT12)
1117 FSAV15 = SQRT(FXI(I)*FXI(I)+FYI(I)*FYI(I)+FZI(I)*FZI(I))*DT12
1118C
1119 NSUB=LISUB(JSUB)
1120 IF(IMS2 > 0 ) THEN
1121 FSAVSUB(4,NSUB)=FSAVSUB(4,NSUB)-FSAV4
1122 FSAVSUB(5,NSUB)=FSAVSUB(5,NSUB)-FSAV5
1123 FSAVSUB(6,NSUB)=FSAVSUB(6,NSUB)-FSAV6
1124 ELSE
1125 FSAVSUB(4,NSUB)=FSAVSUB(4,NSUB)+FSAV4
1126 FSAVSUB(5,NSUB)=FSAVSUB(5,NSUB)+FSAV5
1127 FSAVSUB(6,NSUB)=FSAVSUB(6,NSUB)+FSAV6
1128 ENDIF
1129 FSAVSUB(12,NSUB)=FSAVSUB(12,NSUB)+FSAV12
1130 FSAVSUB(13,NSUB)=FSAVSUB(13,NSUB)+FSAV13
1131 FSAVSUB(14,NSUB)=FSAVSUB(14,NSUB)+FSAV14
1132 FSAVSUB(15,NSUB)=FSAVSUB(15,NSUB)+FSAV15
1133C
1134 IF(ISENSINT(JSUB+1)/=0) THEN
1135 IF(IMS2 > 0 ) THEN
1136 FSAVPARIT(JSUB+1,4,I+NFT) = FXT(I)
1137 FSAVPARIT(JSUB+1,5,I+NFT) = FYT(I)
1138 FSAVPARIT(JSUB+1,6,I+NFT) = FZT(I)
1139 ELSE
1140 FSAVPARIT(JSUB+1,4,I+NFT) = -FXT(I)
1141 FSAVPARIT(JSUB+1,5,I+NFT) = -FYT(I)
1142 FSAVPARIT(JSUB+1,6,I+NFT) = -FZT(I)
1143 ENDIF
1144 ENDIF
1145 END IF
1146
1147 KK=KK+1
1148 KSUB=LISUBM(KK)
1149 ENDDO
1150 JJ=JJ+1
1151
1152 ENDIF
1153 ENDDO
1154
1155 DO WHILE(KK<ADDSUBM(IM+1))
1156 KSUB=LISUBM(KK)
1157
1158 ITYPSUB = TYPSUB(KSUB)
1159 IF(ITYPSUB == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surface : main side
1160C
1161 FSAV4=-FXT(I)*DT12
1162 FSAV5=-FYT(I)*DT12
1163 FSAV6=-FZT(I)*DT12
1164 FSAV12 = ABS(FXI(I)*DT12)
1165 FSAV13 = ABS(FYI(I)*DT12)
1166 FSAV14 = ABS(FZI(I)*DT12)
1167 FSAV15 = SQRT(FXI(I)*FXI(I)+FYI(I)*FYI(I)+FZI(I)*FZI(I))*DT12
1168C
1169 NSUB=LISUB(JSUB)
1170 FSAVSUB(4,NSUB)=FSAVSUB(4,NSUB)+FSAV4
1171 FSAVSUB(5,NSUB)=FSAVSUB(5,NSUB)+FSAV5
1172 FSAVSUB(6,NSUB)=FSAVSUB(6,NSUB)+FSAV6
1173 FSAVSUB(12,NSUB)=FSAVSUB(12,NSUB)+FSAV12
1174 FSAVSUB(13,NSUB)=FSAVSUB(13,NSUB)+FSAV13
1175 FSAVSUB(14,NSUB)=FSAVSUB(14,NSUB)+FSAV14
1176 FSAVSUB(15,NSUB)=FSAVSUB(15,NSUB)+FSAV15
1177C
1178 IF(ISENSINT(JSUB+1)/=0) THEN
1179 FSAVPARIT(JSUB+1,4,I+NFT) = -FXT(I)
1180 FSAVPARIT(JSUB+1,5,I+NFT) = -FYT(I)
1181 FSAVPARIT(JSUB+1,6,I+NFT) = -FZT(I)
1182 ENDIF
1183C
1184 JJ = JJ + 1
1185
1186 ENDIF
1187 KK=KK+1
1188 ENDDO
1189 ELSE
1190C-- Remote SECONDARY line
1191 IS=CS_LOC(I)-NRTS
1192 JJ =ADDSUBSFI(NIN)%P(IS)
1193 DO WHILE(JJ<ADDSUBSFI(NIN)%P(IS+1))
1194 JSUB=LISUBSFI(NIN)%P(JJ)
1195 ITYPSUB = TYPSUB(JSUB)
1196
1197 IF(ITYPSUB == 1 ) THEN ! Defining specific inter
1198
1199 KSUB=LISUBM(KK)
1200.AND. DO WHILE((KSUB<=JSUB)(KK<ADDSUBM(IM+1)))
1201 IF(KSUB==JSUB)THEN
1202C
1203 FSAV4=FXT(I)*DT12
1204 FSAV5=FYT(I)*DT12
1205 FSAV6=FZT(I)*DT12
1206 FSAV12 = ABS(FXI(I)*DT12)
1207 FSAV13 = ABS(FYI(I)*DT12)
1208 FSAV14 = ABS(FZI(I)*DT12)
1209 FSAV15 = SQRT(FXI(I)*FXI(I)+FYI(I)*FYI(I)+FZI(I)*FZI(I))*DT12
1210C
1211 NSUB=LISUB(JSUB)
1212 FSAVSUB(4,NSUB)=FSAVSUB(4,NSUB)+FSAV4
1213 FSAVSUB(5,NSUB)=FSAVSUB(5,NSUB)+FSAV5
1214 FSAVSUB(6,NSUB)=FSAVSUB(6,NSUB)+FSAV6
1215 FSAVSUB(12,NSUB)=FSAVSUB(12,NSUB)+FSAV12
1216 FSAVSUB(13,NSUB)=FSAVSUB(13,NSUB)+FSAV13
1217 FSAVSUB(14,NSUB)=FSAVSUB(14,NSUB)+FSAV14
1218 FSAVSUB(15,NSUB)=FSAVSUB(15,NSUB)+FSAV15
1219C
1220 IF(ISENSINT(JSUB+1)/=0) THEN
1221 FSAVPARIT(JSUB+1,4,I+NFT) = FXT(I)
1222 FSAVPARIT(JSUB+1,5,I+NFT) = FYT(I)
1223 FSAVPARIT(JSUB+1,6,I+NFT) = FZT(I)
1224 ENDIF
1225 END IF
1226
1227 KK=KK+1
1228 KSUB=LISUBM(KK)
1229 ENDDO
1230 JJ=JJ+1
1231
1232 ELSEIF(ITYPSUB == 2 ) THEN ! Inter =0 : collecting forces from all inter with only 1 surf
1233C
1234 FSAV4=FXT(I)*DT12
1235 FSAV5=FYT(I)*DT12
1236 FSAV6=FZT(I)*DT12
1237 FSAV12 = ABS(FXI(I)*DT12)
1238 FSAV13 = ABS(FYI(I)*DT12)
1239 FSAV14 = ABS(FZI(I)*DT12)
1240 FSAV15 = SQRT(FXI(I)*FXI(I)+FYI(I)*FYI(I)+FZI(I)*FZI(I))*DT12
1241C
1242 NSUB=LISUB(JSUB)
1243 FSAVSUB(4,NSUB)=FSAVSUB(4,NSUB)+FSAV4
1244 FSAVSUB(5,NSUB)=FSAVSUB(5,NSUB)+FSAV5
1245 FSAVSUB(6,NSUB)=FSAVSUB(6,NSUB)+FSAV6
1246 FSAVSUB(12,NSUB)=FSAVSUB(12,NSUB)+FSAV12
1247 FSAVSUB(13,NSUB)=FSAVSUB(13,NSUB)+FSAV13
1248 FSAVSUB(14,NSUB)=FSAVSUB(14,NSUB)+FSAV14
1249 FSAVSUB(15,NSUB)=FSAVSUB(15,NSUB)+FSAV15
1250C
1251 IF(ISENSINT(JSUB+1)/=0) THEN
1252 FSAVPARIT(JSUB+1,4,I+NFT) = FXT(I)
1253 FSAVPARIT(JSUB+1,5,I+NFT) = FYT(I)
1254 FSAVPARIT(JSUB+1,6,I+NFT) = FZT(I)
1255 ENDIF
1256C
1257 JJ = JJ + 1
1258
1259 ELSEIF(ITYPSUB == 3 ) THEN ! Inter =0 : collecting forces from all inter with 2 Surfs
1260
1261 ISS2 = BITGET(INFLG_SUBSFI(NIN)%P(JJ),0)
1262 ISS1 = BITGET(INFLG_SUBSFI(NIN)%P(JJ),1)
1263 KSUB=LISUBM(KK)
1264.AND. DO WHILE((KSUB<=JSUB)(KK<ADDSUBM(IM+1)))
1265 IMS2 = BITGET(INFLG_SUBM(KK),0)
1266 IMS1 = BITGET(INFLG_SUBM(KK),1)
1267 IF(KSUB==JSUB)THEN
1268.NOT..AND..OR. IF(((IMS1 == 1 ISS2 == 1)
1269.AND. . (IMS2 == 1 ISS1 == 1))) THEN
1270 KK=KK+1
1271 KSUB=LISUBM(KK)
1272 CYCLE
1273 END IF
1274C
1275 FSAV4=FXT(I)*DT12
1276 FSAV5=FYT(I)*DT12
1277 FSAV6=FZT(I)*DT12
1278 FSAV12 = ABS(FXI(I)*DT12)
1279 FSAV13 = ABS(FYI(I)*DT12)
1280 FSAV14 = ABS(FZI(I)*DT12)
1281 FSAV15 = SQRT(FXI(I)*FXI(I)+FYI(I)*FYI(I)+FZI(I)*FZI(I))*DT12
1282C
1283 NSUB=LISUB(JSUB)
1284 IF(IMS2 > 0) THEN
1285 FSAVSUB(4,NSUB)=FSAVSUB(4,NSUB)-FSAV4
1286 FSAVSUB(5,NSUB)=FSAVSUB(5,NSUB)-FSAV5
1287 FSAVSUB(6,NSUB)=FSAVSUB(6,NSUB)-FSAV6
1288 ELSE
1289 FSAVSUB(4,NSUB)=FSAVSUB(4,NSUB)+FSAV4
1290 FSAVSUB(5,NSUB)=FSAVSUB(5,NSUB)+FSAV5
1291 FSAVSUB(6,NSUB)=FSAVSUB(6,NSUB)+FSAV6
1292 ENDIF
1293 FSAVSUB(12,NSUB)=FSAVSUB(12,NSUB)+FSAV12
1294 FSAVSUB(13,NSUB)=FSAVSUB(13,NSUB)+FSAV13
1295 FSAVSUB(14,NSUB)=FSAVSUB(14,NSUB)+FSAV14
1296 FSAVSUB(15,NSUB)=FSAVSUB(15,NSUB)+FSAV15
1297C
1298 IF(ISENSINT(JSUB+1)/=0) THEN
1299 IF(IMS2 > 0) THEN
1300 FSAVPARIT(JSUB+1,4,I+NFT) = -FXT(I)
1301 FSAVPARIT(JSUB+1,5,I+NFT) = -FYT(I)
1302 FSAVPARIT(JSUB+1,6,I+NFT) = -FZT(I)
1303 ELSE
1304 FSAVPARIT(JSUB+1,4,I+NFT) = FXT(I)
1305 FSAVPARIT(JSUB+1,5,I+NFT) = FYT(I)
1306 FSAVPARIT(JSUB+1,6,I+NFT) = FZT(I)
1307 ENDIF
1308 ENDIF
1309 END IF
1310
1311 KK=KK+1
1312 KSUB=LISUBM(KK)
1313 ENDDO
1314 JJ=JJ+1
1315
1316 ENDIF
1317 ENDDO
1318 ENDIF
1319
1320 ENDDO
1321C
1322 ENDIF
1323C
1324 IF (INCONV==1) THEN
1325#include "lockon.inc"
1326 ECONTV = ECONTV + ECONVT ! Frictional Energy
1327 ECONT = ECONT + ECONTT ! Elastic Energy
1328 ECONTD = ECONTD + ECONTDT ! Damping Energy
1329 FSAV(26) = FSAV(26) + ECONTT
1330 FSAV(27) = FSAV(27) + ECONVT
1331 FSAV(28) = FSAV(28) + ECONTDT
1332#include "lockoff.inc"
1333 ENDIF
1334C---------------------------------
1335 DO I=1,JLT
1336 FX1(I)=-FXI(I)*HS1(I)
1337 FY1(I)=-FYI(I)*HS1(I)
1338 FZ1(I)=-FZI(I)*HS1(I)
1339C
1340 FX2(I)=-FXI(I)*HS2(I)
1341 FY2(I)=-FYI(I)*HS2(I)
1342 FZ2(I)=-FZI(I)*HS2(I)
1343C
1344 FX3(I)=FXI(I)*HM1(I)
1345 FY3(I)=FYI(I)*HM1(I)
1346 FZ3(I)=FZI(I)*HM1(I)
1347C
1348 FX4(I)=FXI(I)*HM2(I)
1349 FY4(I)=FYI(I)*HM2(I)
1350 FZ4(I)=FZI(I)*HM2(I)
1351C
1352 ENDDO
1353C
1354 IF (NSPMD>1) THEN
1355ctmp+1 mic only
1356#include "mic_lockon.inc"
1357 DO I = 1,JLT
1358 IF(CS_LOC(I)>NRTS)THEN
1359 NI = CS_LOC(I)-NRTS
1360C tag temporaire de NSVFI a -
1361 NSVFI(NIN)%P(NI) = -ABS(NSVFI(NIN)%P(NI))
1362 ENDIF
1363 ENDDO
1364ctmp+1 mic only
1365#include "mic_lockoff.inc"
1366 ENDIF
1367C
1368 DO I=1,JLT
1369 STIF(I) = TWO*STIF(I)
1370 ENDDO
1371C
1372C---------------------------------
1373.OR..OR. IF(KDTINT==1IDTMINS==2IDTMINS_INT/=0)THEN
1374 IF( (VISC/=ZERO)
1375.AND..OR. . (IVIS2==0IVIS2==1))THEN
1376 DO I=1,JLT
1377 CX= C(I)*C(I)
1378C
1379 IF(MS1(I)==ZERO)THEN
1380 K1(I) =ZERO
1381 C1(I) =ZERO
1382 ELSE
1383 K1(I)=KT(I)*ABS(HS1(I))
1384 C1(I)=C(I)*ABS(HS1(I))
1385 CX =FOUR*C1(I)*C1(I)
1386 CY =EIGHT*MS1(I)*K1(I)
1387 AUX = SQRT(CX+CY)+TWO*C1(I)
1388 ST1(I)= K1(I)*AUX*AUX/MAX(CY,EM30)
1389 CFI = CF(I)*ABS(HS1(I))
1390 AUX = TWO*CFI*CFI/MAX(MS1(I),EM20)
1391 IF(AUX>ST1(I))THEN
1392 K1(I) =ZERO
1393 C1(I) =CFI
1394 ENDIF
1395 ENDIF
1396C
1397 IF(MS2(I)==ZERO)THEN
1398 K2(I) =ZERO
1399 C2(I) =ZERO
1400 ELSE
1401 K2(I)=KT(I)*ABS(HS2(I))
1402 C2(I)=C(I)*ABS(HS2(I))
1403 CX =FOUR*C2(I)*C2(I)
1404 CY =EIGHT*MS2(I)*K2(I)
1405 AUX = SQRT(CX+CY)+TWO*C2(I)
1406 ST2(I)= K2(I)*AUX*AUX/MAX(CY,EM30)
1407 CFI = CF(I)*ABS(HS2(I))
1408 AUX = TWO*CFI*CFI/MAX(MS2(I),EM20)
1409 IF(AUX>ST2(I))THEN
1410 K2(I) =ZERO
1411 C2(I) =CFI
1412 ENDIF
1413 ENDIF
1414C
1415 IF(MM1(I)==ZERO)THEN
1416 K3(I) =ZERO
1417 C3(I) =ZERO
1418 ELSE
1419 K3(I)=KT(I)*ABS(HM1(I))
1420 C3(I)=C(I)*ABS(HM1(I))
1421 CX =FOUR*C3(I)*C3(I)
1422 CY =EIGHT*MM1(I)*K3(I)
1423 AUX = SQRT(CX+CY)+TWO*C3(I)
1424 ST3(I)= K3(I)*AUX*AUX/MAX(CY,EM30)
1425 CFI = CF(I)*ABS(HM1(I))
1426 AUX = TWO*CFI*CFI/MAX(MM1(I),EM20)
1427 IF(AUX>ST3(I))THEN
1428 K3(I) =ZERO
1429 C3(I) =CFI
1430 ENDIF
1431 ENDIF
1432C
1433 IF(MM2(I)==ZERO)THEN
1434 K4(I) =ZERO
1435 C4(I) =ZERO
1436 ELSE
1437 K4(I)=KT(I)*ABS(HM2(I))
1438 C4(I)=C(I)*ABS(HM2(I))
1439 CX =FOUR*C4(I)*C4(I)
1440 CY =EIGHT*MM2(I)*K4(I)
1441 AUX = SQRT(CX+CY)+TWO*C4(I)
1442 ST4(I)= K4(I)*AUX*AUX/MAX(CY,EM30)
1443 CFI = CF(I)*ABS(HM2(I))
1444 AUX = TWO*CFI*CFI/MAX(MM2(I),EM20)
1445 IF(AUX>ST4(I))THEN
1446 K4(I) =ZERO
1447 C4(I) =CFI
1448 ENDIF
1449 ENDIF
1450 ENDDO
1451 ELSE
1452 DO I=1,JLT
1453 K1(I) =STIF(I)*ABS(HS1(I))
1454 C1(I) =ZERO
1455 K2(I) =STIF(I)*ABS(HS2(I))
1456 C2(I) =ZERO
1457 K3(I) =STIF(I)*ABS(HM1(I))
1458 C3(I) =ZERO
1459 K4(I) =STIF(I)*ABS(HM2(I))
1460 C4(I) =ZERO
1461 ENDDO
1462 ENDIF
1463 ENDIF
1464C
1465C
1466.OR. IF(IDTM==1IDTM==2)THEN
1467 DTMI0 = EP20
1468 DO I=1,JLT
1469 DTMI(I) = EP20
1470 MAS2 = TWO * MASMIN(I)
1471.AND. IF(MAS2>ZEROSTIF(I)>ZERO)THEN
1472 DTMI(I) = MIN(DTMI(I),DTFAC1(10)*SQRT(MAS2/STIF(I)))
1473 ENDIF
1474 DTMI0 = MIN(DTMI0,DTMI(I))
1475 ENDDO
1476 IF(DTMI0<=DTM)THEN
1477 DO I=1,JLT
1478 IF(DTMI(I)<=DTM)THEN
1479 IF(IDTM==1)THEN
1480#include "lockon.inc"
1481 IF(CS_LOC(I)<=NRTS) THEN
1482 WRITE(IOUT,'(a,e12.4,a,i10,a,e12.4,a)')
1483 . ' **warning minimum time step ',DTMI(I),
1484 . ' in INTERFACE nb',NOINT,'(dtmin=',DTM,')'
1485 WRITE(IOUT,*)'secondary nodes nb',ITAB(N1(I)),
1486 . ITAB(N2(I))
1487 WRITE(IOUT,*)'main nodes nb',ITAB(M1(I)),
1488 . ITAB(M2(I))
1489 ELSE
1490 WRITE(IOUT,'(a,e12.4,a,i10,a,e12.4,a)')
1491 . ' **warning minimum time step ',DTMI(I),
1492 . ' in INTERFACE nb',NOINT,'(dtmin=',DTM,')'
1493 WRITE(IOUT,*)'secondary nodes nb',ITAFI(NIN)%P(N1(I)),
1494 . ITAFI(NIN)%P(N2(I))
1495 WRITE(IOUT,*)'main nodes nb',ITAB(M1(I)),
1496 . ITAB(M2(I))
1497 END IF
1498#include "lockoff.inc"
1499 TSTOP = TT
1500 ELSEIF(IDTM==2)THEN
1501#include "lockon.inc"
1502 IF(CS_LOC(I)<=NRTS) THEN
1503 WRITE(IOUT,'(a,e12.4,a,i10,a,e12.4,a)')
1504 . ' **warning minimum time step ',DTMI(I),
1505 . ' in INTERFACE nb',NOINT,'(dtmin=',DTM,')'
1506 WRITE(IOUT,*)'secondary nodes nb',itab(n1(i)),
1507 . itab(n2(i))
1508 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
1509 . itab(m2(i))
1510 WRITE(iout,*)'DELETE SECONDARY LINE FROM INTERFACE'
1511 stfs(cs_loc(i)) = -abs(stfs(cs_loc(i)))
1512 ELSE
1513 ni = cs_loc(i)-nrts
1514 WRITE(iout,'(A,E12.4,A,I10,A,E12.4,A)')
1515 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
1516 . ' IN INTERFACE NB',noint,'(DTMIN=',dtm,')'
1517 WRITE(iout,*)'SECONDARY NODES NB',itafi(nin)%P(n1(i)),
1518 . itafi(nin)%P(n2(i))
1519 WRITE(iout,*)'MAIN NODES NB',itab(m1(i)),
1520 . itab(m2(i))
1521 WRITE(iout,*)'DELETE SECONDARY LINE FROM INTERFACE'
1522 stifi(nin)%P(ni) = -abs(stifi(nin)%P(ni))
1523 END IF
1524#include "lockoff.inc"
1525 newfront = -1
1526 ELSEIF(idtm==5)THEN
1527#include "lockon.inc"
1528 IF(cs_loc(i)<=nrts) THEN
1529 WRITE(iout,'(A,E12.4,A,I10,A,E12.4,A)')
1530 . ' **WARNING MINIMUM TIME STEP ',dtmi(i),
1531 . ' IN INTERFACE NB',noint,'(dtmin=',DTM,')'
1532 WRITE(IOUT,*)'secondary nodes nb',ITAB(N1(I)),
1533 . ITAB(N2(I))
1534 WRITE(IOUT,*)'main nodes nb',ITAB(M1(I)),
1535 . ITAB(M2(I))
1536 ELSE
1537 WRITE(IOUT,'(a,e12.4,a,i10,a,e12.4,a)')
1538 . ' **warning minimum time step ',DTMI(I),
1539 . ' in INTERFACE nb',NOINT,'(dtmin=',DTM,')'
1540 WRITE(IOUT,*)'secondary nodes nb',ITAFI(NIN)%P(N1(I)),
1541 . ITAFI(NIN)%P(N2(I))
1542 WRITE(IOUT,*)'main nodes nb',ITAB(M1(I)),
1543 . ITAB(M2(I))
1544 END IF
1545#include "lockoff.inc"
1546 MSTOP = 2
1547 ENDIF
1548 ENDIF
1549 ENDDO
1550 ENDIF
1551 ENDIF
1552C
1553 RETURN
1554 END
1555C
1556
i11for3
subroutine i11for3(jlt, fsav, gap, fric, ms, visc, viscf, noint, itab, cs_loc, cm_loc, stif, dt2t, hs1, hs2, hm1, hm2, n1, n2, m1, m2, ivis2, neltst, ityptst, nx, ny, nz, gapv, penis, penim, inacti, newfront, nrts, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, nin, dtmini, iform, cand_fx, cand_fy, cand_fz, index, ifpen, stfs, fni, fx1, fy1, fz1, fx2, fy2, fz2, fx3, fy3, fz3, fx4, fy4, fz4, k1, k2, k3, k4, c1, c2, c3, c4, intth, drad, penrad, isensint, fsavparit, nisub, nft, addsubs, addsubm, lisubs, lisubm, lisub, fsavsub, fricc, viscffric, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, typsub, inflg_subs, inflg_subm, ninloadp, dgaploadint, s_loadpinter)
Definition i11for3.F:55
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::penfi
type(real_pointer2), dimension(:), allocatable penfi
Definition tri7box.F:459
tri7box::itafi
type(int_pointer), dimension(:), allocatable itafi
Definition tri7box.F:440
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841