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!|| output_mod ../common_source/modules/output/output_mod.F90
31!|| tri7box ../engine/share/modules/tri7box.F
32!||====================================================================
33 SUBROUTINE i11for3(OUTPUT,
34 1 JLT ,FSAV ,GAP ,FRIC ,MS ,
35 2 VISC ,VISCF ,NOINT ,ITAB ,CS_LOC ,
36 3 CM_LOC ,STIF ,DT2T ,HS1 ,HS2 ,
37 4 HM1 ,HM2 ,N1 ,N2 , M1 ,
38 5 M2 ,IVIS2 ,NELTST ,ITYPTST ,NX ,
39 6 NY ,NZ ,GAPV ,PENIS ,PENIM ,
40 7 INACTI ,NEWFRONT ,NRTS ,MS1 ,MS2 ,
41 8 MM1 ,MM2 ,VXS1 ,VYS1 ,VZS1 ,
42 9 VXS2 ,VYS2 ,VZS2 ,VXM1 ,VYM1 ,
43 A VZM1 ,VXM2 ,VYM2 ,VZM2 ,NIN ,
44 B DTMINI ,IFORM ,CAND_FX ,CAND_FY ,CAND_FZ ,
45 C INDEX ,IFPEN ,STFS ,FNI ,
46 E FX1 ,FY1 ,FZ1 ,FX2 ,FY2 ,
47 F FZ2 ,FX3 ,FY3 ,FZ3 ,FX4 ,
48 G FY4 ,FZ4 ,K1 ,K2 ,K3 ,
49 H K4 ,C1 ,C2 ,C3 ,C4 ,
50 I INTTH ,DRAD ,PENRAD ,ISENSINT,FSAVPARIT,
51 J NISUB ,NFT ,ADDSUBS ,ADDSUBM ,LISUBS ,
52 K LISUBM ,LISUB ,FSAVSUB ,FRICC ,VISCFFRIC,
53 L TAGNCONT ,KLOADPINTER,LOADPINTER,LOADP_HYD_INTER,
54 M TYPSUB ,INFLG_SUBS ,INFLG_SUBM,NINLOADP ,
55 N DGAPLOADINT,S_LOADPINTER )
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 IF(ivis2==0.OR.ivis2==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 IF(kdtint==0.AND.(idtmins/=2.AND.idtmins_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 DO WHILE((ksub<=jsub).AND.(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 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
645 ims2 = bitget(inflg_subm(kk),0)
646 ims1 = bitget(inflg_subm(kk),1)
647 IF(ksub==jsub)THEN
648 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
649 . (ims2 == 1 .AND. 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 DO WHILE((ksub<=jsub).AND.(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 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
817 ims2 = bitget(inflg_subm(kk),0)
818 ims1 = bitget(inflg_subm(kk),1)
819 IF(ksub==jsub)THEN
820 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
821 . (ims2 == 1 .AND. 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 IF(pene(i) > zero .OR.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 DO WHILE((ksub<=jsub).AND.(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 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
1104 ims2 = bitget(inflg_subm(kk),0)
1105 ims1 = bitget(inflg_subm(kk),1)
1106 IF(ksub==jsub)THEN
1107 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
1108 . (ims2 == 1 .AND. 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 DO WHILE((ksub<=jsub).AND.(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 DO WHILE((ksub<=jsub).AND.(kk<addsubm(im+1)))
1268 ims2 = bitget(inflg_subm(kk),0)
1269 ims1 = bitget(inflg_subm(kk),1)
1270 IF(ksub==jsub)THEN
1271 IF(.NOT.((ims1 == 1 .AND. iss2 == 1).OR.
1272 . (ims2 == 1 .AND. 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 IF(kdtint==1.OR.idtmins==2.OR.idtmins_int/=0)THEN
1377 IF( (visc/=zero)
1378 . .AND.(ivis2==0.OR.ivis2==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 IF(idtm==1.OR.idtm==2)THEN
1470 dtmi0 = ep20
1471 DO i=1,jlt
1472 dtmi(i) = ep20
1473 mas2 = two * masmin(i)
1474 IF(mas2>zero.AND.stif(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
1557 END
1558C
1559
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)
Definition i11for3.F:56
subroutine i11mainf(output, timers, ipari, x, a, icodt, fsav, v, ms, dt2t, neltst, ityptst, itab, stifn, fskyi, isky, fcont, nin, lindmax, jtask, nb_jlt, nb_jlt_new, nb_stok_n, niskyfi, newfront, nstrf, secfcum, viscn, num_imp, ns_imp, ne_imp, mskyi_sms, iskyi_sms, nodnx_sms, icontact, intbuf_tab, pm, temp, fthe, ftheskyi, npc, tf, condn, condnskyi, fbsav6, isensint, dimfb, fsavsub, h3d_data, intbuf_fric_tab, itask, tagncont, kloadpinter, loadpinter, loadp_hyd_inter, dgaploadint, s_loadpinter, nodadt_therm)
Definition i11mainf.F:62
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
type(int_pointer), dimension(:), allocatable inflg_subsfi
Definition tri7box.F:505
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
type(real_pointer2), dimension(:), allocatable penfi
Definition tri7box.F:459
type(int_pointer), dimension(:), allocatable lisubsfi
Definition tri7box.F:501
type(int_pointer), dimension(:), allocatable nsvfi
Definition tri7box.F:431
type(int_pointer), dimension(:), allocatable addsubsfi
Definition tri7box.F:509
type(int_pointer), dimension(:), allocatable itafi
Definition tri7box.F:440
int main(int argc, char *argv[])