OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11keg3.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!|| i11keg3 ../engine/source/interfaces/int11/i11keg3.F
25!||--- called by ------------------------------------------------------
26!|| i11ke3 ../engine/source/interfaces/int11/i11ke3.F
27!||--- uses -----------------------------------------------------
28!|| imp_intm ../engine/share/modules/imp_intm.F
29!|| tri7box ../engine/share/modules/tri7box.F
30!||====================================================================
31 SUBROUTINE i11keg3(
32 1 JLT ,A ,V ,GAP ,FRIC ,
33 2 MS ,CS_LOC ,CM_LOC ,STIGLO ,STIF ,
34 3 HS1 ,HS2 ,HM1 ,HM2 ,NX ,
35 4 NY ,NZ ,GAPV ,PENIS ,PENIM ,
36 5 INACTI ,NRTS ,MS1 ,MS2 ,MM1 ,
37 6 MM2 ,VXS1 ,VYS1 ,VZS1 ,VXS2 ,
38 7 VYS2 ,VZS2 ,VXM1 ,VYM1 ,VZM1 ,
39 8 VXM2 ,VYM2 ,VZM2 ,K1I11 ,K1I12 ,
40 9 K1J11 ,K1J12 ,K2I11 ,K2I12 ,K2J11 ,
41 A K2J12 ,N1 ,N2 ,NIN ,LREM ,
42 B OFF ,SCALK ,IDESAC )
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE tri7box
47 USE imp_intm
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52#include "comlock.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com01_c.inc"
61#include "scr05_c.inc"
62#include "impl1_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER JLT,INACTI,NRTS,NIN,LREM,IDESAC
67 INTEGER CS_LOC(MVSIZ), CM_LOC(MVSIZ),N1(MVSIZ), N2(MVSIZ)
68 my_real
69 . STIGLO,A(3,*), MS(*), V(3,*),
70 . GAPV(*),PENIS(2,*), PENIM(2,*),GAP, FRIC,SCALK
71 my_real
72 . HS1(MVSIZ), HS2(MVSIZ), HM1(MVSIZ), HM2(MVSIZ),
73 . NX(MVSIZ), NY(MVSIZ), NZ(MVSIZ), STIF(MVSIZ),
74 . MS1(MVSIZ),MS2(MVSIZ),MM1(MVSIZ),MM2(MVSIZ), OFF(MVSIZ),
75 . VXS1(MVSIZ),VYS1(MVSIZ),VZS1(MVSIZ),VXS2(MVSIZ),VYS2(MVSIZ),
76 . VZS2(MVSIZ),VXM1(MVSIZ),VYM1(MVSIZ),VZM1(MVSIZ),VXM2(MVSIZ),
77 . vym2(mvsiz),vzm2(mvsiz),k1i11(3,3,mvsiz),k1j11(3,3,mvsiz),
78 . k2i11(3,3,mvsiz),k2j11(3,3,mvsiz),k1i12(3,3,mvsiz),
79 . k1j12(3,3,mvsiz),k2i12(3,3,mvsiz),k2j12(3,3,mvsiz)
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I, J1, J , K0,K1S,K, NI,ISF,NN,NS,JLTF,NE,NN1,NN2
84 my_real
85 . VX(MVSIZ), VY(MVSIZ), VZ(MVSIZ), VN(MVSIZ),PENE(MVSIZ),
86 . VNX, VNY, VNZ, AA, VMAX,S2,DIST,RDIST,
87 . V2, FM2, DT1INV, VISCA, FAC, FF,
88 . FX, FY, FZ, F2, MAS2, FACM1, PPLUS
89 my_real
90 . PREC,FACT(MVSIZ),KN(4,MVSIZ),Q(3,3,MVSIZ),
91 . H1(MVSIZ), H2(MVSIZ), H3(MVSIZ), H4(MVSIZ)
92 my_real
93 . Q11,Q12,Q13,Q22,Q23,Q33,H00,VTX,VTY,VTZ,VT,
94 . kt1,kt2,kt3,kt4,q1,q2,facf
95C-----------------------------------------------
96 IF (iresp == 1) THEN
97 prec = fiveem4
98 ELSE
99 prec = em10
100 ENDIF
101C
102 DO i=1,jlt
103 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
104 pene(i) = gapv(i) - s2
105 s2 = one/max(em30,s2)
106 nx(i) = nx(i)*s2
107 ny(i) = ny(i)*s2
108 nz(i) = nz(i)*s2
109 ENDDO
110C
111 IF(inacti==5)THEN
112 DO i=1,jlt
113 IF(cs_loc(i)<=nrts) THEN
114 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),half*pene(i))
115 ELSE
116 ni = cs_loc(i)-nrts
117 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),half*pene(i))
118 END IF
119 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),half*pene(i))
120 ENDDO
121 DO i=1,jlt
122 IF(cs_loc(i)<=nrts) THEN
123 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
124 pene(i) = max(pene(i),zero)
125 IF(pene(i)==zero)stif(i)=zero
126 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
127 ELSE
128 ni = cs_loc(i)-nrts
129 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
130 pene(i) = max(pene(i),zero)
131 IF(pene(i)==zero)stif(i)=zero
132 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
133 END IF
134 END DO
135 ELSE IF(inacti==6)THEN
136 DO i=1,jlt
137 pplus=half*(pene(i)+fiveem2*(gapv(i)-pene(i)))
138 IF(cs_loc(i)<=nrts) THEN
139 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),pplus)
140 ELSE
141 ni = cs_loc(i)-nrts
142 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),pplus)
143 END IF
144 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),pplus)
145 ENDDO
146 DO i=1,jlt
147 IF(cs_loc(i)<=nrts) THEN
148 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
149 pene(i) = max(pene(i),zero)
150 IF(pene(i)==zero)stif(i)=zero
151 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
152 ELSE
153 ni = cs_loc(i)-nrts
154 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
155 pene(i) = max(pene(i),zero)
156 IF(pene(i)==zero)stif(i)=zero
157 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
158 END IF
159 END DO
160 ENDIF
161C
162 DO i=1,jlt
163 gapv(i) = zep9*gapv(i)
164 vx(i) = hs1(i)*vxs1(i) + hs2(i)*vxs2(i)
165 . - hm1(i)*vxm1(i) - hm2(i)*vxm2(i)
166 vy(i) = hs1(i)*vys1(i) + hs2(i)*vys2(i)
167 . - hm1(i)*vym1(i) - hm2(i)*vym2(i)
168 vz(i) = hs1(i)*vzs1(i) + hs2(i)*vzs2(i)
169 . - hm1(i)*vzm1(i) - hm2(i)*vzm2(i)
170 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
171 h1(i) = hs1(i)*hm1(i)
172 h2(i) = hs1(i)*hm2(i)
173 h3(i) = hs2(i)*hm1(i)
174 h4(i) = hs2(i)*hm2(i)
175 ENDDO
176C-------------------------------------------
177C
178 IF(imp_int7>=2)THEN
179 DO i=1,jlt
180 stif(i) = half*stif(i)
181 ENDDO
182 ELSEIF(imp_int7==1)THEN
183 DO i=1,jlt
184 fac = gapv(i)/max( em10,( gapv(i)-pene(i) ) )
185 IF(( (gapv(i)-pene(i))/gapv(i) )<prec .AND.
186 . stif(i)>zero ) THEN
187 stif(i) = zero
188 pene(i)= zero
189 idesac = 1
190 ELSE
191 stif(i) = half*stif(i) * fac
192 ENDIF
193 ENDDO
194 ELSE
195 DO i=1,jlt
196 fac = gapv(i)/max( em10,( gapv(i)-pene(i) ) )
197 IF(( (gapv(i)-pene(i))/gapv(i) )<prec .AND.
198 . stif(i)>zero ) THEN
199 stif(i) = zero
200 pene(i)= zero
201 idesac = 1
202 ELSE
203 stif(i) = half*stif(i) * fac
204 ENDIF
205 ENDDO
206 DO i=1,jlt
207 stif(i) = stif(i) * gapv(i) /
208 . max((gapv(i) - pene(i)),em10)
209 ENDDO
210C
211 END IF !(IMP_INT7>=2)
212 IF(idesac>0) RETURN
213C
214C---------------------------------
215C ----sans frottement d'abord---
216C---------------------------------
217 DO i=1,jlt
218 vtx = vx(i) -vn(i)*nx(i)
219 vty = vy(i) -vn(i)*ny(i)
220 vtz = vz(i) -vn(i)*nz(i)
221 vt = vtx*vtx+vty*vty+vtz*vtz
222 IF (vt>em20) THEN
223 s2=one/sqrt(vt)
224 q(1,1,i)=vtx*s2
225 q(1,2,i)=vty*s2
226 q(1,3,i)=vtz*s2
227 q(3,1,i)=nx(i)
228 q(3,2,i)=ny(i)
229 q(3,3,i)=nz(i)
230 q(2,1,i)=q(3,2,i)*q(1,3,i)-q(3,3,i)*q(1,2,i)
231 q(2,2,i)=q(3,3,i)*q(1,1,i)-q(3,1,i)*q(1,3,i)
232 q(2,3,i)=q(3,1,i)*q(1,2,i)-q(3,2,i)*q(1,1,i)
233 fact(i)=fric
234 ELSE
235 fact(i)=zero
236 ENDIF
237 ENDDO
238 IF (scalk<0) THEN
239 isf=1
240 ELSE
241 isf=0
242 ENDIF
243 facf=abs(scalk)
244 IF (isf==1) THEN
245 DO i=1,jlt
246 IF (vn(i)>zero) THEN
247 fac=stif(i)*facf
248c write(iout,*)'FAC+,VN(I)=',FAC,VN(I),I
249 ELSEIF (vn(i)<zero) THEN
250 fac=stif(i)/facf
251c write(iout,*)'FAC-,VN(I)=',FAC,VN(I),I
252 ELSE
253 fac=stif(i)
254 ENDIF
255 kn(1,i)=fac*h1(i)
256 kn(2,i)=fac*h2(i)
257 kn(3,i)=fac*h3(i)
258 kn(4,i)=fac*h4(i)
259 fact(i)=fac*fact(i)
260 ENDDO
261 ELSE
262 DO i=1,jlt
263 fac=stif(i)*facf
264 kn(1,i)=fac*h1(i)
265 kn(2,i)=fac*h2(i)
266 kn(3,i)=fac*h3(i)
267 kn(4,i)=fac*h4(i)
268 fact(i)=fac*fact(i)
269 ENDDO
270 ENDIF
271 DO i=1,jlt
272 q11=nx(i)*nx(i)
273 q12=nx(i)*ny(i)
274 q13=nx(i)*nz(i)
275 q22=ny(i)*ny(i)
276 q23=ny(i)*nz(i)
277 q33=nz(i)*nz(i)
278 k1i11(1,1,i)=kn(1,i)*q11
279 k1i11(1,2,i)=kn(1,i)*q12
280 k1i11(1,3,i)=kn(1,i)*q13
281 k1i11(2,2,i)=kn(1,i)*q22
282 k1i11(2,3,i)=kn(1,i)*q23
283 k1i11(3,3,i)=kn(1,i)*q33
284 k1j11(1,1,i)=kn(2,i)*q11
285 k1j11(1,2,i)=kn(2,i)*q12
286 k1j11(1,3,i)=kn(2,i)*q13
287 k1j11(2,2,i)=kn(2,i)*q22
288 k1j11(2,3,i)=kn(2,i)*q23
289 k1j11(3,3,i)=kn(2,i)*q33
290 k2i11(1,1,i)=kn(3,i)*q11
291 k2i11(1,2,i)=kn(3,i)*q12
292 k2i11(1,3,i)=kn(3,i)*q13
293 k2i11(2,2,i)=kn(3,i)*q22
294 k2i11(2,3,i)=kn(3,i)*q23
295 k2i11(3,3,i)=kn(3,i)*q33
296 k2j11(1,1,i)=kn(4,i)*q11
297 k2j11(1,2,i)=kn(4,i)*q12
298 k2j11(1,3,i)=kn(4,i)*q13
299 k2j11(2,2,i)=kn(4,i)*q22
300 k2j11(2,3,i)=kn(4,i)*q23
301 k2j11(3,3,i)=kn(4,i)*q33
302 ENDDO
303C ----avec frottement ---
304 DO j=1,3
305 DO k=j,3
306 DO i=1,jlt
307 IF (fact(i)>zero) THEN
308 q1 =q(1,j,i)*q(1,k,i)
309 q2 =q(2,j,i)*q(2,k,i)
310 fac=fact(i)*(q1+q2)
311 kt1=fac*h1(i)
312 k1i11(j,k,i)=k1i11(j,k,i)+kt1
313 kt2=fac*h2(i)
314 k1j11(j,k,i)=k1j11(j,k,i)+kt2
315 kt3=fac*h3(i)
316 k2i11(j,k,i)=k2i11(j,k,i)+kt3
317 kt4=fac*h4(i)
318 k2j11(j,k,i)=k2j11(j,k,i)+kt4
319 ENDIF
320 ENDDO
321 ENDDO
322 ENDDO
323C
324 DO j=1,3
325 DO k=j,3
326 DO i=1,jlt
327 k1i12(j,k,i)=-k1i11(j,k,i)
328 k1j12(j,k,i)=-k1j11(j,k,i)
329 k2i12(j,k,i)=-k2i11(j,k,i)
330 k2j12(j,k,i)=-k2j11(j,k,i)
331 ENDDO
332 ENDDO
333 ENDDO
334 DO j=1,3
335 DO k=j+1,3
336 DO i=1,jlt
337 k1i12(k,j,i)=-k1i11(j,k,i)
338 k1j12(k,j,i)=-k1j11(j,k,i)
339 k2i12(k,j,i)=-k2i11(j,k,i)
340 k2j12(k,j,i)=-k2j11(j,k,i)
341 ENDDO
342 ENDDO
343 ENDDO
344C
345 DO i=1,jlt
346 off(i)=one
347 ENDDO
348C
349 IF (nspmd>1) THEN
350 IF ((intp_d)>0) THEN
351 DO i=1,jlt
352 IF(cs_loc(i)>nrts) THEN
353 nn=cs_loc(i)-nrts
354 ns=ind_int(nin)%P(nn)
355C---------pour temporairement diag_ss---
356 nn1 = ns
357 ffi(1,nn1)=zero
358 ffi(2,nn1)=zero
359 ffi(3,nn1)=zero
360 dfi(1,nn1)=zero
361 dfi(2,nn1)=zero
362 dfi(3,nn1)=zero
363 nn2 = nn1 + 1
364 ffi(1,nn2)=zero
365 ffi(2,nn2)=zero
366 ffi(3,nn2)=zero
367 dfi(1,nn2)=zero
368 dfi(2,nn2)=zero
369 dfi(3,nn2)=zero
370 ENDIF
371 ENDDO
372 ELSE
373 jltf = 0
374 DO i=1,jlt
375 IF(cs_loc(i)>nrts) THEN
376 jltf = jltf + 1
377 ne=shf_int(nin) + jltf +lrem
378 nn=cs_loc(i)-nrts
379 ns=ind_int(nin)%P(nn)
380 stifs(ne)=stif(i)
381 h_e(1,ne)=hs1(i)
382 h_e(2,ne)=hs2(i)
383 h_e(3,ne)=hm1(i)
384 h_e(4,ne)=hm2(i)
385 n_e(1,ne)=nx(i)
386 n_e(2,ne)=ny(i)
387 n_e(3,ne)=nz(i)
388C---------pour temporairement diag_ss---
389 nn1 = ns
390 ffi(1,nn1)=zero
391 ffi(2,nn1)=zero
392 ffi(3,nn1)=zero
393 dfi(1,nn1)=zero
394 dfi(2,nn1)=zero
395 dfi(3,nn1)=zero
396 nn2 = nn1 + 1
397 ffi(1,nn2)=zero
398 ffi(2,nn2)=zero
399 ffi(3,nn2)=zero
400 dfi(1,nn2)=zero
401 dfi(2,nn2)=zero
402 dfi(3,nn2)=zero
403 ENDIF
404 ENDDO
405 ENDIF
406 ENDIF
407C
408 RETURN
409 END
410!||====================================================================
411!|| i11frf3 ../engine/source/interfaces/int11/i11keg3.F
412!||--- called by ------------------------------------------------------
413!|| i11forcf3 ../engine/source/interfaces/int11/i11ke3.F
414!||--- uses -----------------------------------------------------
415!|| imp_intm ../engine/share/modules/imp_intm.F
416!||====================================================================
417 SUBROUTINE i11frf3(JLT ,A ,V ,FRIC ,HS1 ,
418 1 HS2 ,HM1 ,HM2 ,NX ,NY ,
419 2 NZ ,MS1 ,MS2 ,MM1 ,MM2 ,
420 3 VXS1 ,VYS1 ,VZS1 ,VXS2 ,VYS2 ,
421 4 VZS2 ,VXM1 ,VYM1 ,VZM1 ,VXM2 ,
422 5 VYM2 ,VZM2 ,N1 ,N2 ,M1 ,
423 6 M2 ,DXS1 ,DYS1 ,DZS1 ,DXS2 ,
424 7 DYS2 ,DZS2 ,DXM1 ,DYM1 ,DZM1 ,
425 8 DXM2 ,DYM2 ,DZM2 ,STIF , NIN ,
426 9 SCALK )
427C-----------------------------------------------
428C M o d u l e s
429C-----------------------------------------------
430 USE imp_intm
431C-----------------------------------------------
432C I m p l i c i t T y p e s
433C-----------------------------------------------
434#include "implicit_f.inc"
435C-----------------------------------------------
436C G l o b a l P a r a m e t e r s
437C-----------------------------------------------
438#include "mvsiz_p.inc"
439C-----------------------------------------------
440C D u m m y A r g u m e n t s
441C-----------------------------------------------
442 INTEGER JLT,NIN
443 INTEGER N1(MVSIZ), N2(MVSIZ), M1(MVSIZ), M2(MVSIZ)
444 my_real
445 . A(3,*), V(3,*),FRIC,SCALK
446 my_real
447 . HS1(MVSIZ), HS2(MVSIZ), HM1(MVSIZ), HM2(MVSIZ),
448 . NX(MVSIZ), NY(MVSIZ), NZ(MVSIZ), STIF(MVSIZ),
449 . MS1(MVSIZ),MS2(MVSIZ),MM1(MVSIZ),MM2(MVSIZ),
450 . vxs1(mvsiz),vys1(mvsiz),vzs1(mvsiz),vxs2(mvsiz),vys2(mvsiz),
451 . vzs2(mvsiz),vxm1(mvsiz),vym1(mvsiz),vzm1(mvsiz),vxm2(mvsiz),
452 . vym2(mvsiz),vzm2(mvsiz),dxs1(mvsiz),dys1(mvsiz),dzs1(mvsiz),
453 . dxs2(mvsiz),dys2(mvsiz),dzs2(mvsiz),dxm1(mvsiz),dym1(mvsiz),
454 . dzm1(mvsiz),dxm2(mvsiz),dym2(mvsiz),dzm2(mvsiz)
455C-----------------------------------------------
456C L o c a l V a r i a b l e s
457C-----------------------------------------------
458 INTEGER I, J1, J, K,IG,ISF,NN,NS,NI,NJ
459 my_real
460 . VX(MVSIZ), VY(MVSIZ), VZ(MVSIZ), VN(MVSIZ),
461 . DX(MVSIZ), DY(MVSIZ), DZ(MVSIZ), DN(MVSIZ),
462 . dxi(mvsiz), dyi(mvsiz), dzi(mvsiz),
463 . dni(mvsiz),dt(mvsiz), dti(mvsiz),
464 . s2,facn(mvsiz),facf, fact(mvsiz)
465 my_real
466 . fx,fy,fz,fn,ft,fni,fti,vtx,vty,vtz,vt,
467 . t1(mvsiz), t2(mvsiz), t3(mvsiz),
468 . kt1,kt2,kt3,kt4,q1,q2
469
470C-----------------------------------------------
471C
472 DO i=1,jlt
473 vx(i) = hs1(i)*vxs1(i) + hs2(i)*vxs2(i)
474 . - hm1(i)*vxm1(i) - hm2(i)*vxm2(i)
475 vy(i) = hs1(i)*vys1(i) + hs2(i)*vys2(i)
476 . - hm1(i)*vym1(i) - hm2(i)*vym2(i)
477 vz(i) = hs1(i)*vzs1(i) + hs2(i)*vzs2(i)
478 . - hm1(i)*vzm1(i) - hm2(i)*vzm2(i)
479 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
480 dxi(i) = hs1(i)*dxs1(i) + hs2(i)*dxs2(i)
481 dyi(i) = hs1(i)*dys1(i) + hs2(i)*dys2(i)
482 dzi(i) = hs1(i)*dzs1(i) + hs2(i)*dzs2(i)
483 dni(i) = nx(i)*dxi(i) + ny(i)*dyi(i) + nz(i)*dzi(i)
484C
485 dx(i) = dxi(i)- hm1(i)*dxm1(i) - hm2(i)*dxm2(i)
486 dy(i) = dyi(i)- hm1(i)*dym1(i) - hm2(i)*dym2(i)
487 dz(i) = dzi(i)- hm1(i)*dzm1(i) - hm2(i)*dzm2(i)
488 dn(i) = nx(i)*dx(i) + ny(i)*dy(i) + nz(i)*dz(i)
489 ENDDO
490C-------------------------------------------
491 DO i=1,jlt
492 vtx = vx(i) -vn(i)*nx(i)
493 vty = vy(i) -vn(i)*ny(i)
494 vtz = vz(i) -vn(i)*nz(i)
495 vt = vtx*vtx+vty*vty+vtz*vtz
496 IF (vt>em20) THEN
497 s2=one/sqrt(vt)
498 t1(i)=vtx*s2
499 t2(i)=vty*s2
500 t3(i)=vtz*s2
501 fact(i)=fric
502 ELSE
503 fact(i)=zero
504 t1(i)=one
505 t2(i)=zero
506 t3(i)=zero
507 ENDIF
508 ENDDO
509 DO i=1,jlt
510 dt(i) = t1(i)*dx(i) + t2(i)*dy(i) + t3(i)*dz(i)
511 dti(i) = t1(i)*dxi(i) + t2(i)*dyi(i) + t3(i)*dzi(i)
512 ENDDO
513 IF (scalk<0) THEN
514 isf=1
515 ELSE
516 isf=0
517 ENDIF
518 facf=abs(scalk)
519 IF (isf==1) THEN
520 DO i=1,jlt
521 IF (vn(i)>zero) THEN
522 facn(i)=stif(i)*facf
523 ELSEIF (vn(i)<zero) THEN
524 facn(i)=stif(i)/facf
525 ELSE
526 facn(i)=stif(i)
527 ENDIF
528 fact(i)=facn(i)*fact(i)
529 ENDDO
530 ELSE
531 DO i=1,jlt
532 facn(i)=stif(i)*facf
533 fact(i)=facn(i)*fact(i)
534 ENDDO
535 ENDIF
536C--------partie NML-------
537 DO i=1,jlt
538 fn = -facn(i)*dni(i)
539 fx=fn*nx(i)
540 fy=fn*ny(i)
541 fz=fn*nz(i)
542 IF (fact(i)/=zero) THEN
543 ft = -fact(i)*dti(i)
544 fx = fx + ft*t1(i)
545 fy = fy + ft*t2(i)
546 fz = fz + ft*t3(i)
547 ENDIF
548 a(1,m1(i))=a(1,m1(i))+fx*hm1(i)
549 a(2,m1(i))=a(2,m1(i))+fy*hm1(i)
550 a(3,m1(i))=a(3,m1(i))+fz*hm1(i)
551 a(1,m2(i))=a(1,m2(i))+fx*hm2(i)
552 a(2,m2(i))=a(2,m2(i))+fy*hm2(i)
553 a(3,m2(i))=a(3,m2(i))+fz*hm2(i)
554 ENDDO
555C--------partie NSL-------
556 DO i=1,jlt
557 fni = facn(i)*dn(i)
558 fx=fni*nx(i)
559 fy=fni*ny(i)
560 fz=fni*nz(i)
561 IF (fact(i)/=zero) THEN
562 ft = fact(i)*dt(i)
563 fx = fx + ft*t1(i)
564 fy = fy + ft*t2(i)
565 fz = fz + ft*t3(i)
566 ENDIF
567 ni = n1(i)
568 ffi(1,ni)=ffi(1,ni)+fx*hs1(i)
569 ffi(2,ni)=ffi(2,ni)+fy*hs1(i)
570 ffi(3,ni)=ffi(3,ni)+fz*hs1(i)
571 nj = n2(i)
572 ffi(1,nj)=ffi(1,nj)+fx*hs2(i)
573 ffi(2,nj)=ffi(2,nj)+fy*hs2(i)
574 ffi(3,nj)=ffi(3,nj)+fz*hs2(i)
575 ENDDO
576C
577 RETURN
578 END
579!||====================================================================
580!|| i11kfor3 ../engine/source/interfaces/int11/i11keg3.F
581!||--- called by ------------------------------------------------------
582!|| i11fku3 ../engine/source/interfaces/int11/i11ke3.F
583!||--- uses -----------------------------------------------------
584!|| imp_intm ../engine/share/modules/imp_intm.F
585!|| tri7box ../engine/share/modules/tri7box.F
586!||====================================================================
587 SUBROUTINE i11kfor3(
588 1 JLT ,A ,V ,GAP ,MS ,
589 2 CS_LOC ,CM_LOC ,STIF ,FRIC ,
590 3 HS1 ,HS2 ,HM1 ,HM2 ,NX ,
591 4 NY ,NZ ,GAPV ,PENIS ,PENIM ,
592 5 INACTI ,NRTS ,MS1 ,MS2 ,MM1 ,
593 6 MM2 ,VXS1 ,VYS1 ,VZS1 ,VXS2 ,
594 7 VYS2 ,VZS2 ,VXM1 ,VYM1 ,VZM1 ,
595 8 VXM2 ,VYM2 ,VZM2 ,N1 ,N2 ,
596 9 M1 ,M2 ,NIN ,DXS1 ,DYS1 ,
597 A DZS1 ,DXS2 ,DYS2 ,DZS2 ,D ,
598 B SCALK )
599C-----------------------------------------------
600C M o d u l e s
601C-----------------------------------------------
602 USE tri7box
603 USE imp_intm
604C-----------------------------------------------
605C I m p l i c i t T y p e s
606C-----------------------------------------------
607#include "implicit_f.inc"
608#include "comlock.inc"
609C-----------------------------------------------
610C G l o b a l P a r a m e t e r s
611C-----------------------------------------------
612#include "mvsiz_p.inc"
613C-----------------------------------------------
614C C o m m o n B l o c k s
615C-----------------------------------------------
616#include "scr05_c.inc"
617#include "impl1_c.inc"
618C-----------------------------------------------
619C D u m m y A r g u m e n t s
620C-----------------------------------------------
621 INTEGER JLT,INACTI,NRTS,NIN,LREM,IDESAC
622 INTEGER CS_LOC(MVSIZ), CM_LOC(MVSIZ),N1(MVSIZ), N2(MVSIZ),
623 . M1(MVSIZ), M2(MVSIZ)
624 my_real
625 . MS(*), A(3,*),V(3,*),
626 . GAPV(*),PENIS(2,*), PENIM(2,*),GAP,STIF(*),FRIC
627 my_real
628 . HS1(MVSIZ), HS2(MVSIZ), HM1(MVSIZ), HM2(MVSIZ),
629 . NX(MVSIZ), NY(MVSIZ), NZ(MVSIZ),
630 . MS1(MVSIZ),MS2(MVSIZ),MM1(MVSIZ),MM2(MVSIZ),
631 . VXS1(MVSIZ),VYS1(MVSIZ),VZS1(MVSIZ),VXS2(MVSIZ),VYS2(MVSIZ),
632 . VZS2(MVSIZ),VXM1(MVSIZ),VYM1(MVSIZ),VZM1(MVSIZ),VXM2(MVSIZ),
633 . vym2(mvsiz),vzm2(mvsiz),scalk,
634 . dxs1(mvsiz),dys1(mvsiz),dzs1(mvsiz),
635 . dxs2(mvsiz),dys2(mvsiz),dzs2(mvsiz),d(3,*)
636C-----------------------------------------------
637C L o c a l V a r i a b l e s
638C-----------------------------------------------
639 INTEGER I, J1, J , K0,K1S,K, NI,NN,NS,JLTF,NE,NN1,NN2,NM1,NM2
640 my_real
641 . DXM1(MVSIZ),DYM1(MVSIZ),DZM1(MVSIZ),DXM2(MVSIZ),
642 . DYM2(MVSIZ),DZM2(MVSIZ),
643 . VX(MVSIZ), VY(MVSIZ), VZ(MVSIZ), VN(MVSIZ),PENE(MVSIZ),
644 . DX(MVSIZ), DY(MVSIZ), DZ(MVSIZ), DN(MVSIZ),
645 . DXI(MVSIZ),DYI(MVSIZ), DZI(MVSIZ),DNI(MVSIZ),
646 . FXI(MVSIZ),FYI(MVSIZ), FZI(MVSIZ),FNI(MVSIZ),
647 . VNX, VNY, VNZ, AA, VMAX,S2,DIST,RDIST,
648 . V2, FM2, VISCA, FAC, FF,DXT,T1,T2,T3,FTN,
649 . FX, FY, FZ, F2, MAS2, FACM1, PPLUS,GAP2,PENE2,PREC
650C-----------------------------------------------
651 IF (IRESP == 1) then
652 prec = fiveem4
653 ELSE
654 prec = em10
655 ENDIF
656 DO i=1,jlt
657 nm1 = m1(i)
658 nm2 = m2(i)
659 dxm1(i) = d(1,nm1)
660 dym1(i) = d(2,nm1)
661 dzm1(i) = d(3,nm1)
662 dxm2(i) = d(1,nm2)
663 dym2(i) = d(2,nm2)
664 dzm2(i) = d(3,nm2)
665 ENDDO
666c DO I=1,JLT
667c IF(CS_LOC(I)>NRTS) THEN
668c DXS1(I) = ZERO
669c DYS1(I) = ZERO
670c DZS1(I) = ZERO
671c DXS2(I) = ZERO
672c DYS2(I) = ZERO
673c DZS2(I) = ZERO
674c ELSE
675c NN1 = N1(I)
676c NN2 = N2(I)
677c DXS1(I) = D(1,NN1)
678c DYS1(I) = D(2,NN1)
679c DZS1(I) = D(3,NN1)
680c DXS2(I) = D(1,NN2)
681c DYS2(I) = D(2,NN2)
682c DZS2(I) = D(3,NN2)
683c ENDIF
684c ENDDO
685C
686 DO i=1,jlt
687 gap2 = gapv(i)*gapv(i)
688 pene2 = gap2 - nx(i)*nx(i) - ny(i)*ny(i) - nz(i)*nz(i)
689 pene2 = max(zero,pene2)
690 IF(pene2==zero) stif(i) = zero
691 ENDDO
692C
693 DO i=1,jlt
694 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
695 pene(i) = gapv(i) - s2
696 s2 = one/max(em30,s2)
697 nx(i) = nx(i)*s2
698 ny(i) = ny(i)*s2
699 nz(i) = nz(i)*s2
700 ENDDO
701C
702 IF(inacti==5)THEN
703 DO i=1,jlt
704 IF(cs_loc(i)<=nrts) THEN
705 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),half*pene(i))
706 ELSE
707 ni = cs_loc(i)-nrts
708 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),half*pene(i))
709 END IF
710 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),half*pene(i))
711 ENDDO
712 DO i=1,jlt
713 IF(cs_loc(i)<=nrts) THEN
714 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
715 pene(i) = max(pene(i),zero)
716 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
717 ELSE
718 ni = cs_loc(i)-nrts
719 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
720 pene(i) = max(pene(i),zero)
721 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
722 END IF
723 END DO
724 ELSE IF(inacti==6)THEN
725 DO i=1,jlt
726 pplus=half*(pene(i)+fiveem2*(gapv(i)-pene(i)))
727 IF(cs_loc(i)<=nrts) THEN
728 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),pplus)
729 ELSE
730 ni = cs_loc(i)-nrts
731 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),pplus)
732 END IF
733 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),pplus)
734 ENDDO
735 DO i=1,jlt
736 IF(cs_loc(i)<=nrts) THEN
737 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
738 pene(i) = max(pene(i),zero)
739 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
740 ELSE
741 ni = cs_loc(i)-nrts
742 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
743 pene(i) = max(pene(i),zero)
744 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
745 END IF
746 END DO
747 ENDIF
748C
749 DO i=1,jlt
750 gapv(i) = zep9*gapv(i)
751 vx(i) = hs1(i)*vxs1(i) + hs2(i)*vxs2(i)
752 . - hm1(i)*vxm1(i) - hm2(i)*vxm2(i)
753 vy(i) = hs1(i)*vys1(i) + hs2(i)*vys2(i)
754 . - hm1(i)*vym1(i) - hm2(i)*vym2(i)
755 vz(i) = hs1(i)*vzs1(i) + hs2(i)*vzs2(i)
756 . - hm1(i)*vzm1(i) - hm2(i)*vzm2(i)
757 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
758 dxi(i) = hs1(i)*dxs1(i) + hs2(i)*dxs2(i)
759 dyi(i) = hs1(i)*dys1(i) + hs2(i)*dys2(i)
760 dzi(i) = hs1(i)*dzs1(i) + hs2(i)*dzs2(i)
761 dni(i) = nx(i)*dxi(i) + ny(i)*dyi(i) + nz(i)*dzi(i)
762C
763 dx(i) = dxi(i)- hm1(i)*dxm1(i) - hm2(i)*dxm2(i)
764 dy(i) = dyi(i)- hm1(i)*dym1(i) - hm2(i)*dym2(i)
765 dz(i) = dzi(i)- hm1(i)*dzm1(i) - hm2(i)*dzm2(i)
766 dn(i) = nx(i)*dx(i) + ny(i)*dy(i) + nz(i)*dz(i)
767 ENDDO
768C-------------------------------------------
769C
770 IF(imp_int7>=2)THEN
771 DO i=1,jlt
772 stif(i) = half*stif(i)
773 ENDDO
774 ELSEIF(imp_int7==1)THEN
775 DO i=1,jlt
776 fac = gapv(i)/max( em10,( gapv(i)-pene(i) ) )
777 IF(( (gapv(i)-pene(i))/gapv(i) )<prec .AND.
778 . stif(i)>zero ) THEN
779 stif(i) = zero
780 pene(i)= zero
781 idesac = 1
782 ELSE
783 stif(i) = half*stif(i) * fac
784 ENDIF
785 ENDDO
786 ELSE
787 DO i=1,jlt
788 fac = gapv(i)/max( em10,( gapv(i)-pene(i) ) )
789 IF(( (gapv(i)-pene(i))/gapv(i) )<prec .AND.
790 . stif(i)>zero ) THEN
791 stif(i) = zero
792 pene(i)= zero
793 idesac = 1
794 ELSE
795 stif(i) = half*stif(i) * fac
796 ENDIF
797 ENDDO
798 DO i=1,jlt
799 stif(i) = stif(i) * gapv(i) /
800 . max((gapv(i) - pene(i)),em10)
801 ENDDO
802C
803 END IF !(IMP_INT7>=2)
804C
805 fac = abs(scalk)
806 DO i=1,jlt
807 stif(i)=stif(i)*fac
808 fni(i)= -stif(i) * dn(i)
809 fxi(i)=nx(i)*fni(i)
810 fyi(i)=ny(i)*fni(i)
811 fzi(i)=nz(i)*fni(i)
812 ENDDO
813C---------------------------------
814C FRICTION
815C---------------------------------
816 IF(fric/=zero)THEN
817 DO i=1,jlt
818 vnx = nx(i)*dn(i)
819 vny = ny(i)*dn(i)
820 vnz = nz(i)*dn(i)
821 vx(i) = dx(i) - vnx
822 vy(i) = dy(i) - vny
823 vz(i) = dz(i) - vnz
824 v2 = vx(i)**2 + vy(i)**2 + vz(i)**2
825 dxt = sqrt(v2)
826 aa = dxt/max(em30,v2)
827 t1 = vx(i)*aa
828 t2 = vy(i)*aa
829 t3 = vz(i)*aa
830 ftn = -fric*stif(i) * dxt
831 fx = ftn * t1
832 fy = ftn * t2
833 fz = ftn * t3
834 fxi(i)=fxi(i) + fx
835 fyi(i)=fyi(i) + fy
836 fzi(i)=fzi(i) + fz
837 ENDDO
838 ENDIF
839C
840C--------main part-------
841c
842 DO i=1,jlt
843 nm1 = m1(i)
844 nm2 = m2(i)
845 a(1,nm1)=a(1,nm1)+fxi(i)*hm1(i)
846 a(2,nm1)=a(2,nm1)+fyi(i)*hm1(i)
847 a(3,nm1)=a(3,nm1)+fzi(i)*hm1(i)
848 a(1,nm2)=a(1,nm2)+fxi(i)*hm2(i)
849 a(2,nm2)=a(2,nm2)+fyi(i)*hm2(i)
850 a(3,nm2)=a(3,nm2)+fzi(i)*hm2(i)
851 ENDDO
852C--------secnd part-------
853 DO i=1,jlt
854 IF(cs_loc(i)<=nrts) THEN
855 nn1 = n1(i)
856 nn2 = n2(i)
857 a(1,nn1)=a(1,nn1)-fxi(i)*hs1(i)
858 a(2,nn1)=a(2,nn1)-fyi(i)*hs1(i)
859 a(3,nn1)=a(3,nn1)-fzi(i)*hs1(i)
860 a(1,nn2)=a(1,nn2)-fxi(i)*hs2(i)
861 a(2,nn2)=a(2,nn2)-fyi(i)*hs2(i)
862 a(3,nn2)=a(3,nn2)-fzi(i)*hs2(i)
863 ELSE
864 nn=cs_loc(i)-nrts
865 ns=ind_int(nin)%P(nn)
866C---------pour temporairement diag_ss---
867 nn1 = ns
868 ffi(1,nn1)=ffi(1,nn1)-fxi(i)*hs1(i)
869 ffi(2,nn1)=ffi(2,nn1)-fyi(i)*hs1(i)
870 ffi(3,nn1)=ffi(3,nn1)-fzi(i)*hs1(i)
871 nn2 = nn1 + 1
872 ffi(1,nn2)= ffi(1,nn2)-fxi(i)*hs2(i)
873 ffi(2,nn2)= ffi(2,nn2)-fyi(i)*hs2(i)
874 ffi(3,nn2)= ffi(3,nn2)-fzi(i)*hs2(i)
875 ENDIF
876 ENDDO
877C
878 RETURN
879 END
i11keg3
subroutine i11keg3(jlt, a, v, gap, fric, ms, cs_loc, cm_loc, stiglo, stif, hs1, hs2, hm1, hm2, nx, ny, nz, gapv, penis, penim, inacti, nrts, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, k1i11, k1i12, k1j11, k1j12, k2i11, k2i12, k2j11, k2j12, n1, n2, nin, lrem, off, scalk, idesac)
Definition i11keg3.F:43
i11frf3
subroutine i11frf3(jlt, a, v, fric, hs1, hs2, hm1, hm2, nx, ny, nz, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, n1, n2, m1, m2, dxs1, dys1, dzs1, dxs2, dys2, dzs2, dxm1, dym1, dzm1, dxm2, dym2, dzm2, stif, nin, scalk)
Definition i11keg3.F:427
i11kfor3
subroutine i11kfor3(jlt, a, v, gap, ms, cs_loc, cm_loc, stif, fric, hs1, hs2, hm1, hm2, nx, ny, nz, gapv, penis, penim, inacti, nrts, ms1, ms2, mm1, mm2, vxs1, vys1, vzs1, vxs2, vys2, vzs2, vxm1, vym1, vzm1, vxm2, vym2, vzm2, n1, n2, m1, m2, nin, dxs1, dys1, dzs1, dxs2, dys2, dzs2, d, scalk)
Definition i11keg3.F:599
max
#define max(a, b)
Definition macros.h:21
imp_intm
Definition imp_intm.F:118
imp_intm::shf_int
integer, dimension(:), allocatable shf_int
Definition imp_intm.F:136
imp_intm::intp_d
integer intp_d
Definition imp_intm.F:173
imp_intm::ind_int
type(int_pointer2), dimension(:), allocatable ind_int
Definition imp_intm.F:133
tri7box::penfi
type(real_pointer2), dimension(:), allocatable penfi
Definition tri7box.F:459