OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11for3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr05_c.inc"
#include "scr07_c.inc"
#include "scr11_c.inc"
#include "scr18_c.inc"
#include "units_c.inc"
#include "impl1_c.inc"
#include "sms_c.inc"
#include "param_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i11for3 (output, 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)

Function/Subroutine Documentation

◆ i11for3()

subroutine i11for3 ( type(output_), intent(inout) output,
integer jlt,
fsav,
gap,
fric,
ms,
visc,
viscf,
integer noint,
integer, dimension(*) itab,
integer, dimension(mvsiz) cs_loc,
integer, dimension(mvsiz) cm_loc,
stif,
dt2t,
hs1,
hs2,
hm1,
hm2,
integer, dimension(mvsiz) n1,
integer, dimension(mvsiz) n2,
integer, dimension(mvsiz) m1,
integer, dimension(mvsiz) m2,
integer ivis2,
integer neltst,
integer ityptst,
nx,
ny,
nz,
gapv,
penis,
penim,
integer inacti,
integer newfront,
integer nrts,
ms1,
ms2,
mm1,
mm2,
vxs1,
vys1,
vzs1,
vxs2,
vys2,
vzs2,
vxm1,
vym1,
vzm1,
vxm2,
vym2,
vzm2,
integer nin,
dtmini,
integer iform,
cand_fx,
cand_fy,
cand_fz,
integer, dimension(*) index,
integer, dimension(*) ifpen,
stfs,
fni,
fx1,
fy1,
fz1,
fx2,
fy2,
fz2,
fx3,
fy3,
fz3,
fx4,
fy4,
fz4,
k1,
k2,
k3,
k4,
c1,
c2,
c3,
c4,
integer intth,
drad,
penrad,
integer, dimension(*) isensint,
fsavparit,
integer nisub,
integer nft,
integer, dimension(*) addsubs,
integer, dimension(*) addsubm,
integer, dimension(*) lisubs,
integer, dimension(*) lisubm,
integer, dimension(*) lisub,
fsavsub,
fricc,
viscffric,
integer, dimension(nloadp_hyd_inter,numnod) tagncont,
integer, dimension(ninter+1), intent(in) kloadpinter,
integer, dimension(s_loadpinter), intent(in) loadpinter,
integer, dimension(nloadp_hyd), intent(in) loadp_hyd_inter,
integer, dimension(*) typsub,
integer, dimension(*) inflg_subs,
integer, dimension(*) inflg_subm,
integer, intent(in) ninloadp,
dimension(s_loadpinter), intent(in) dgaploadint,
integer, intent(in) s_loadpinter )

Definition at line 33 of file i11for3.F.

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