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, J, K, NI, ISF, NN, NS, JLTF, NE, NN1, NN2
84 my_real
85 . VX(MVSIZ), VY(MVSIZ), VZ(MVSIZ), VN(MVSIZ),PENE(MVSIZ),
86 . S2,
87 . FAC,
88 . 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,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 ---- Without friction first ---
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 with friction
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)
355Cfor temporary 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)
388Cfor temporary 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, ISF, 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,vtx,vty,vtz,vt,
467 . t1(mvsiz), t2(mvsiz), t3(mvsiz)
468C-----------------------------------------------
469C
470 DO i=1,jlt
471 vx(i) = hs1(i)*vxs1(i) + hs2(i)*vxs2(i)
472 . - hm1(i)*vxm1(i) - hm2(i)*vxm2(i)
473 vy(i) = hs1(i)*vys1(i) + hs2(i)*vys2(i)
474 . - hm1(i)*vym1(i) - hm2(i)*vym2(i)
475 vz(i) = hs1(i)*vzs1(i) + hs2(i)*vzs2(i)
476 . - hm1(i)*vzm1(i) - hm2(i)*vzm2(i)
477 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
478 dxi(i) = hs1(i)*dxs1(i) + hs2(i)*dxs2(i)
479 dyi(i) = hs1(i)*dys1(i) + hs2(i)*dys2(i)
480 dzi(i) = hs1(i)*dzs1(i) + hs2(i)*dzs2(i)
481 dni(i) = nx(i)*dxi(i) + ny(i)*dyi(i) + nz(i)*dzi(i)
482C
483 dx(i) = dxi(i)- hm1(i)*dxm1(i) - hm2(i)*dxm2(i)
484 dy(i) = dyi(i)- hm1(i)*dym1(i) - hm2(i)*dym2(i)
485 dz(i) = dzi(i)- hm1(i)*dzm1(i) - hm2(i)*dzm2(i)
486 dn(i) = nx(i)*dx(i) + ny(i)*dy(i) + nz(i)*dz(i)
487 ENDDO
488C-------------------------------------------
489 DO i=1,jlt
490 vtx = vx(i) -vn(i)*nx(i)
491 vty = vy(i) -vn(i)*ny(i)
492 vtz = vz(i) -vn(i)*nz(i)
493 vt = vtx*vtx+vty*vty+vtz*vtz
494 IF (vt>em20) THEN
495 s2=one/sqrt(vt)
496 t1(i)=vtx*s2
497 t2(i)=vty*s2
498 t3(i)=vtz*s2
499 fact(i)=fric
500 ELSE
501 fact(i)=zero
502 t1(i)=one
503 t2(i)=zero
504 t3(i)=zero
505 ENDIF
506 ENDDO
507 DO i=1,jlt
508 dt(i) = t1(i)*dx(i) + t2(i)*dy(i) + t3(i)*dz(i)
509 dti(i) = t1(i)*dxi(i) + t2(i)*dyi(i) + t3(i)*dzi(i)
510 ENDDO
511 IF (scalk<0) THEN
512 isf=1
513 ELSE
514 isf=0
515 ENDIF
516 facf=abs(scalk)
517 IF (isf==1) THEN
518 DO i=1,jlt
519 IF (vn(i)>zero) THEN
520 facn(i)=stif(i)*facf
521 ELSEIF (vn(i)<zero) THEN
522 facn(i)=stif(i)/facf
523 ELSE
524 facn(i)=stif(i)
525 ENDIF
526 fact(i)=facn(i)*fact(i)
527 ENDDO
528 ELSE
529 DO i=1,jlt
530 facn(i)=stif(i)*facf
531 fact(i)=facn(i)*fact(i)
532 ENDDO
533 ENDIF
534C-------- part nml --------
535 DO i=1,jlt
536 fn = -facn(i)*dni(i)
537 fx=fn*nx(i)
538 fy=fn*ny(i)
539 fz=fn*nz(i)
540 IF (fact(i)/=zero) THEN
541 ft = -fact(i)*dti(i)
542 fx = fx + ft*t1(i)
543 fy = fy + ft*t2(i)
544 fz = fz + ft*t3(i)
545 ENDIF
546 a(1,m1(i))=a(1,m1(i))+fx*hm1(i)
547 a(2,m1(i))=a(2,m1(i))+fy*hm1(i)
548 a(3,m1(i))=a(3,m1(i))+fz*hm1(i)
549 a(1,m2(i))=a(1,m2(i))+fx*hm2(i)
550 a(2,m2(i))=a(2,m2(i))+fy*hm2(i)
551 a(3,m2(i))=a(3,m2(i))+fz*hm2(i)
552 ENDDO
553C-------- part nsl --------
554 DO i=1,jlt
555 fni = facn(i)*dn(i)
556 fx=fni*nx(i)
557 fy=fni*ny(i)
558 fz=fni*nz(i)
559 IF (fact(i)/=zero) THEN
560 ft = fact(i)*dt(i)
561 fx = fx + ft*t1(i)
562 fy = fy + ft*t2(i)
563 fz = fz + ft*t3(i)
564 ENDIF
565 ni = n1(i)
566 ffi(1,ni)=ffi(1,ni)+fx*hs1(i)
567 ffi(2,ni)=ffi(2,ni)+fy*hs1(i)
568 ffi(3,ni)=ffi(3,ni)+fz*hs1(i)
569 nj = n2(i)
570 ffi(1,nj)=ffi(1,nj)+fx*hs2(i)
571 ffi(2,nj)=ffi(2,nj)+fy*hs2(i)
572 ffi(3,nj)=ffi(3,nj)+fz*hs2(i)
573 ENDDO
574C
575 RETURN
576 END
577!||====================================================================
578!|| i11kfor3 ../engine/source/interfaces/int11/i11keg3.F
579!||--- called by ------------------------------------------------------
580!|| i11fku3 ../engine/source/interfaces/int11/i11ke3.F
581!||--- uses -----------------------------------------------------
582!|| imp_intm ../engine/share/modules/imp_intm.F
583!|| tri7box ../engine/share/modules/tri7box.F
584!||====================================================================
585 SUBROUTINE i11kfor3(
586 1 JLT ,A ,V ,GAP ,MS ,
587 2 CS_LOC ,CM_LOC ,STIF ,FRIC ,
588 3 HS1 ,HS2 ,HM1 ,HM2 ,NX ,
589 4 NY ,NZ ,GAPV ,PENIS ,PENIM ,
590 5 INACTI ,NRTS ,MS1 ,MS2 ,MM1 ,
591 6 MM2 ,VXS1 ,VYS1 ,VZS1 ,VXS2 ,
592 7 VYS2 ,VZS2 ,VXM1 ,VYM1 ,VZM1 ,
593 8 VXM2 ,VYM2 ,VZM2 ,N1 ,N2 ,
594 9 M1 ,M2 ,NIN ,DXS1 ,DYS1 ,
595 A DZS1 ,DXS2 ,DYS2 ,DZS2 ,D ,
596 B SCALK )
597C-----------------------------------------------
598C M o d u l e s
599C-----------------------------------------------
600 USE tri7box
601 USE imp_intm
602C-----------------------------------------------
603C I m p l i c i t T y p e s
604C-----------------------------------------------
605#include "implicit_f.inc"
606#include "comlock.inc"
607C-----------------------------------------------
608C G l o b a l P a r a m e t e r s
609C-----------------------------------------------
610#include "mvsiz_p.inc"
611C-----------------------------------------------
612C C o m m o n B l o c k s
613C-----------------------------------------------
614#include "scr05_c.inc"
615#include "impl1_c.inc"
616C-----------------------------------------------
617C D u m m y A r g u m e n t s
618C-----------------------------------------------
619 INTEGER JLT, INACTI, NRTS, NIN, IDESAC
620 INTEGER CS_LOC(MVSIZ), CM_LOC(MVSIZ),N1(MVSIZ), N2(MVSIZ),
621 . M1(MVSIZ), M2(MVSIZ)
622 my_real
623 . MS(*), A(3,*),V(3,*),
624 . GAPV(*),PENIS(2,*), PENIM(2,*),GAP,STIF(*),FRIC
625 my_real
626 . HS1(MVSIZ), HS2(MVSIZ), HM1(MVSIZ), HM2(MVSIZ),
627 . NX(MVSIZ), NY(MVSIZ), NZ(MVSIZ),
628 . MS1(MVSIZ),MS2(MVSIZ),MM1(MVSIZ),MM2(MVSIZ),
629 . VXS1(MVSIZ),VYS1(MVSIZ),VZS1(MVSIZ),VXS2(MVSIZ),VYS2(MVSIZ),
630 . VZS2(MVSIZ),VXM1(MVSIZ),VYM1(MVSIZ),VZM1(MVSIZ),VXM2(MVSIZ),
631 . vym2(mvsiz),vzm2(mvsiz),scalk,
632 . dxs1(mvsiz),dys1(mvsiz),dzs1(mvsiz),
633 . dxs2(mvsiz),dys2(mvsiz),dzs2(mvsiz),d(3,*)
634C-----------------------------------------------
635C L o c a l V a r i a b l e s
636C-----------------------------------------------
637 INTEGER I, NI, NN, NS, NN1, NN2, NM1, NM2
638 my_real
639 . DXM1(MVSIZ),DYM1(MVSIZ),DZM1(MVSIZ),DXM2(MVSIZ),
640 . DYM2(MVSIZ),DZM2(MVSIZ),
641 . VX(MVSIZ), VY(MVSIZ), VZ(MVSIZ), VN(MVSIZ),PENE(MVSIZ),
642 . DX(MVSIZ), DY(MVSIZ), DZ(MVSIZ), DN(MVSIZ),
643 . DXI(MVSIZ),DYI(MVSIZ), DZI(MVSIZ),DNI(MVSIZ),
644 . FXI(MVSIZ),FYI(MVSIZ), FZI(MVSIZ),FNI(MVSIZ),
645 . VNX, VNY, VNZ, AA,S2,
646 . V2, FAC,DXT,T1,T2,T3,FTN,
647 . FX, FY, FZ, PPLUS,GAP2,PENE2,PREC
648C-----------------------------------------------
649 IF (IRESP == 1) then
650 prec = fiveem4
651 ELSE
652 prec = em10
653 ENDIF
654 DO i=1,jlt
655 nm1 = m1(i)
656 nm2 = m2(i)
657 dxm1(i) = d(1,nm1)
658 dym1(i) = d(2,nm1)
659 dzm1(i) = d(3,nm1)
660 dxm2(i) = d(1,nm2)
661 dym2(i) = d(2,nm2)
662 dzm2(i) = d(3,nm2)
663 ENDDO
664c DO I=1,JLT
665c IF(CS_LOC(I)>NRTS) THEN
666c DXS1(I) = ZERO
667c DYS1(I) = ZERO
668c DZS1(I) = ZERO
669c DXS2(I) = ZERO
670c DYS2(I) = ZERO
671c DZS2(I) = ZERO
672c ELSE
673c NN1 = N1(I)
674c NN2 = N2(I)
675c DXS1(I) = D(1,NN1)
676c DYS1(I) = D(2,NN1)
677c DZS1(I) = D(3,NN1)
678c DXS2(I) = D(1,NN2)
679c DYS2(I) = D(2,NN2)
680c DZS2(I) = D(3,NN2)
681c ENDIF
682c ENDDO
683C
684 DO i=1,jlt
685 gap2 = gapv(i)*gapv(i)
686 pene2 = gap2 - nx(i)*nx(i) - ny(i)*ny(i) - nz(i)*nz(i)
687 pene2 = max(zero,pene2)
688 IF(pene2==zero) stif(i) = zero
689 ENDDO
690C
691 DO i=1,jlt
692 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
693 pene(i) = gapv(i) - s2
694 s2 = one/max(em30,s2)
695 nx(i) = nx(i)*s2
696 ny(i) = ny(i)*s2
697 nz(i) = nz(i)*s2
698 ENDDO
699C
700 IF(inacti==5)THEN
701 DO i=1,jlt
702 IF(cs_loc(i)<=nrts) THEN
703 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),half*pene(i))
704 ELSE
705 ni = cs_loc(i)-nrts
706 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),half*pene(i))
707 END IF
708 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),half*pene(i))
709 ENDDO
710 DO i=1,jlt
711 IF(cs_loc(i)<=nrts) THEN
712 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
713 pene(i) = max(pene(i),zero)
714 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
715 ELSE
716 ni = cs_loc(i)-nrts
717 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
718 pene(i) = max(pene(i),zero)
719 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
720 END IF
721 END DO
722 ELSE IF(inacti==6)THEN
723 DO i=1,jlt
724 pplus=half*(pene(i)+fiveem2*(gapv(i)-pene(i)))
725 IF(cs_loc(i)<=nrts) THEN
726 penis(2,cs_loc(i)) = max(penis(2,cs_loc(i)),pplus)
727 ELSE
728 ni = cs_loc(i)-nrts
729 penfi(nin)%P(2,ni) = max(penfi(nin)%P(2,ni),pplus)
730 END IF
731 penim(2,cm_loc(i)) = max(penim(2,cm_loc(i)),pplus)
732 ENDDO
733 DO i=1,jlt
734 IF(cs_loc(i)<=nrts) THEN
735 pene(i) = pene(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
736 pene(i) = max(pene(i),zero)
737 gapv(i) = gapv(i) - penis(1,cs_loc(i)) - penim(1,cm_loc(i))
738 ELSE
739 ni = cs_loc(i)-nrts
740 pene(i) = pene(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
741 pene(i) = max(pene(i),zero)
742 gapv(i) = gapv(i) - penfi(nin)%P(1,ni) - penim(1,cm_loc(i))
743 END IF
744 END DO
745 ENDIF
746C
747 DO i=1,jlt
748 gapv(i) = zep9*gapv(i)
749 vx(i) = hs1(i)*vxs1(i) + hs2(i)*vxs2(i)
750 . - hm1(i)*vxm1(i) - hm2(i)*vxm2(i)
751 vy(i) = hs1(i)*vys1(i) + hs2(i)*vys2(i)
752 . - hm1(i)*vym1(i) - hm2(i)*vym2(i)
753 vz(i) = hs1(i)*vzs1(i) + hs2(i)*vzs2(i)
754 . - hm1(i)*vzm1(i) - hm2(i)*vzm2(i)
755 vn(i) = nx(i)*vx(i) + ny(i)*vy(i) + nz(i)*vz(i)
756 dxi(i) = hs1(i)*dxs1(i) + hs2(i)*dxs2(i)
757 dyi(i) = hs1(i)*dys1(i) + hs2(i)*dys2(i)
758 dzi(i) = hs1(i)*dzs1(i) + hs2(i)*dzs2(i)
759 dni(i) = nx(i)*dxi(i) + ny(i)*dyi(i) + nz(i)*dzi(i)
760C
761 dx(i) = dxi(i)- hm1(i)*dxm1(i) - hm2(i)*dxm2(i)
762 dy(i) = dyi(i)- hm1(i)*dym1(i) - hm2(i)*dym2(i)
763 dz(i) = dzi(i)- hm1(i)*dzm1(i) - hm2(i)*dzm2(i)
764 dn(i) = nx(i)*dx(i) + ny(i)*dy(i) + nz(i)*dz(i)
765 ENDDO
766C-------------------------------------------
767C
768 IF(imp_int7>=2)THEN
769 DO i=1,jlt
770 stif(i) = half*stif(i)
771 ENDDO
772 ELSEIF(imp_int7==1)THEN
773 DO i=1,jlt
774 fac = gapv(i)/max( em10,( gapv(i)-pene(i) ) )
775 IF(( (gapv(i)-pene(i))/gapv(i) )<prec .AND.
776 . stif(i)>zero ) THEN
777 stif(i) = zero
778 pene(i)= zero
779 idesac = 1
780 ELSE
781 stif(i) = half*stif(i) * fac
782 ENDIF
783 ENDDO
784 ELSE
785 DO i=1,jlt
786 fac = gapv(i)/max( em10,( gapv(i)-pene(i) ) )
787 IF(( (gapv(i)-pene(i))/gapv(i) )<prec .AND.
788 . stif(i)>zero ) THEN
789 stif(i) = zero
790 pene(i)= zero
791 idesac = 1
792 ELSE
793 stif(i) = half*stif(i) * fac
794 ENDIF
795 ENDDO
796 DO i=1,jlt
797 stif(i) = stif(i) * gapv(i) /
798 . max((gapv(i) - pene(i)),em10)
799 ENDDO
800C
801 END IF !(IMP_INT7>=2)
802C
803 fac = abs(scalk)
804 DO i=1,jlt
805 stif(i)=stif(i)*fac
806 fni(i)= -stif(i) * dn(i)
807 fxi(i)=nx(i)*fni(i)
808 fyi(i)=ny(i)*fni(i)
809 fzi(i)=nz(i)*fni(i)
810 ENDDO
811C---------------------------------
812C FRICTION
813C---------------------------------
814 IF(fric/=zero)THEN
815 DO i=1,jlt
816 vnx = nx(i)*dn(i)
817 vny = ny(i)*dn(i)
818 vnz = nz(i)*dn(i)
819 vx(i) = dx(i) - vnx
820 vy(i) = dy(i) - vny
821 vz(i) = dz(i) - vnz
822 v2 = vx(i)**2 + vy(i)**2 + vz(i)**2
823 dxt = sqrt(v2)
824 aa = dxt/max(em30,v2)
825 t1 = vx(i)*aa
826 t2 = vy(i)*aa
827 t3 = vz(i)*aa
828 ftn = -fric*stif(i) * dxt
829 fx = ftn * t1
830 fy = ftn * t2
831 fz = ftn * t3
832 fxi(i)=fxi(i) + fx
833 fyi(i)=fyi(i) + fy
834 fzi(i)=fzi(i) + fz
835 ENDDO
836 ENDIF
837C
838C--------main part-------
839c
840 DO i=1,jlt
841 nm1 = m1(i)
842 nm2 = m2(i)
843 a(1,nm1)=a(1,nm1)+fxi(i)*hm1(i)
844 a(2,nm1)=a(2,nm1)+fyi(i)*hm1(i)
845 a(3,nm1)=a(3,nm1)+fzi(i)*hm1(i)
846 a(1,nm2)=a(1,nm2)+fxi(i)*hm2(i)
847 a(2,nm2)=a(2,nm2)+fyi(i)*hm2(i)
848 a(3,nm2)=a(3,nm2)+fzi(i)*hm2(i)
849 ENDDO
850C------- Secondary part --------
851 DO i=1,jlt
852 IF(cs_loc(i)<=nrts) THEN
853 nn1 = n1(i)
854 nn2 = n2(i)
855 a(1,nn1)=a(1,nn1)-fxi(i)*hs1(i)
856 a(2,nn1)=a(2,nn1)-fyi(i)*hs1(i)
857 a(3,nn1)=a(3,nn1)-fzi(i)*hs1(i)
858 a(1,nn2)=a(1,nn2)-fxi(i)*hs2(i)
859 a(2,nn2)=a(2,nn2)-fyi(i)*hs2(i)
860 a(3,nn2)=a(3,nn2)-fzi(i)*hs2(i)
861 ELSE
862 nn=cs_loc(i)-nrts
863 ns=ind_int(nin)%P(nn)
864Cfor temporary diag_ss
865 nn1 = ns
866 ffi(1,nn1)=ffi(1,nn1)-fxi(i)*hs1(i)
867 ffi(2,nn1)=ffi(2,nn1)-fyi(i)*hs1(i)
868 ffi(3,nn1)=ffi(3,nn1)-fzi(i)*hs1(i)
869 nn2 = nn1 + 1
870 ffi(1,nn2)= ffi(1,nn2)-fxi(i)*hs2(i)
871 ffi(2,nn2)= ffi(2,nn2)-fyi(i)*hs2(i)
872 ffi(3,nn2)= ffi(3,nn2)-fzi(i)*hs2(i)
873 ENDIF
874 ENDDO
875C
876 RETURN
877 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:597
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