OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i5keg3.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!|| i5keg3 ../engine/source/interfaces/inter3d/i5keg3.F
25!||--- called by ------------------------------------------------------
26!|| i5ke3 ../engine/source/interfaces/inter3d/i5ke3.F
27!||====================================================================
28 SUBROUTINE i5keg3(LFT ,LLT ,FRIC ,SCALK ,
29 3 TNJ ,KI11 ,KI12 ,KJ11 ,KJ12 ,
30 4 KK11 ,KK12 ,KL11 ,KL12 ,OFF ,
31 5 N1 ,N2 ,N3 ,STIF ,H1 ,
32 6 H2 ,H3 ,H4)
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C G l o b a l P a r a m e t e r s
39C-----------------------------------------------
40#include "mvsiz_p.inc"
41C-----------------------------------------------
42C D u m m y A r g u m e n t s
43C-----------------------------------------------
44 INTEGER LFT ,LLT
45 my_real
46 . FRIC,OFF(*),SCALK,TNJ(3,MVSIZ)
47 my_real
48 . ki11(3,3,mvsiz),kj11(3,3,mvsiz),
49 . kk11(3,3,mvsiz),kl11(3,3,mvsiz),ki12(3,3,mvsiz),
50 . kj12(3,3,mvsiz),kk12(3,3,mvsiz),kl12(3,3,mvsiz)
51 my_real, DIMENSION(MVSIZ), INTENT(IN) :: n1,n2,n3,stif
52 my_real, DIMENSION(MVSIZ), INTENT(IN) :: h1,h2,h3,h4
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER I, J1, J, K,IG,ISF,NN,NS,JLTF,NE,L
57 my_real
58 . S2,FAC,FACF, H0, LA1, LA2, LA3, LA4,FACT(MVSIZ),
59 . D1,D2,D3,D4,A1,A2,A3,A4,KN(4,MVSIZ),Q(3,3,MVSIZ)
60 my_real
61 . prec,q11,q12,q13,q22,q23,q33,h00,vtx,vty,vtz,vt,
62 . kt1,kt2,kt3,kt4,q1,q2
63C-----------------------------------------------
64C ----sans frottement d'abord---
65 DO i=lft,llt
66 fac=stif(i)*scalk
67 kn(1,i)=fac*h1(i)
68 kn(2,i)=fac*h2(i)
69 kn(3,i)=fac*h3(i)
70 kn(4,i)=fac*h4(i)
71 ENDDO
72C
73 DO i=lft,llt
74 q11=n1(i)*n1(i)
75 q12=n1(i)*n2(i)
76 q13=n1(i)*n3(i)
77 q22=n2(i)*n2(i)
78 q23=n2(i)*n3(i)
79 q33=n3(i)*n3(i)
80 ki11(1,1,i)=kn(1,i)*q11
81 ki11(1,2,i)=kn(1,i)*q12
82 ki11(1,3,i)=kn(1,i)*q13
83 ki11(2,2,i)=kn(1,i)*q22
84 ki11(2,3,i)=kn(1,i)*q23
85 ki11(3,3,i)=kn(1,i)*q33
86 kj11(1,1,i)=kn(2,i)*q11
87 kj11(1,2,i)=kn(2,i)*q12
88 kj11(1,3,i)=kn(2,i)*q13
89 kj11(2,2,i)=kn(2,i)*q22
90 kj11(2,3,i)=kn(2,i)*q23
91 kj11(3,3,i)=kn(2,i)*q33
92 kk11(1,1,i)=kn(3,i)*q11
93 kk11(1,2,i)=kn(3,i)*q12
94 kk11(1,3,i)=kn(3,i)*q13
95 kk11(2,2,i)=kn(3,i)*q22
96 kk11(2,3,i)=kn(3,i)*q23
97 kk11(3,3,i)=kn(3,i)*q33
98 kl11(1,1,i)=kn(4,i)*q11
99 kl11(1,2,i)=kn(4,i)*q12
100 kl11(1,3,i)=kn(4,i)*q13
101 kl11(2,2,i)=kn(4,i)*q22
102 kl11(2,3,i)=kn(4,i)*q23
103 kl11(3,3,i)=kn(4,i)*q33
104 ENDDO
105C ----avec frottement ---
106 IF (fric>zero) THEN
107C ----tangent vector ---
108 fac= fric*scalk
109 DO i=lft,llt
110 q(1,1,i)=tnj(1,i)
111 q(1,2,i)=tnj(2,i)
112 q(1,3,i)=tnj(3,i)
113 q(3,1,i)=n1(i)
114 q(3,2,i)=n2(i)
115 q(3,3,i)=n3(i)
116 q(2,1,i)=q(3,2,i)*q(1,3,i)-q(3,3,i)*q(1,2,i)
117 q(2,2,i)=q(3,3,i)*q(1,1,i)-q(3,1,i)*q(1,3,i)
118 q(2,3,i)=q(3,1,i)*q(1,2,i)-q(3,2,i)*q(1,1,i)
119 fact(i)=stif(i)*fac
120 ENDDO
121C
122 DO j=1,3
123 DO k=j,3
124 DO i=lft,llt
125 q1 =q(1,j,i)*q(1,k,i)
126 q2 =q(2,j,i)*q(2,k,i)
127 fac=fact(i)*(q1+q2)
128 kt1=fac*h1(i)
129 ki11(j,k,i)=ki11(j,k,i)+kt1
130 kt2=fac*h2(i)
131 kj11(j,k,i)=kj11(j,k,i)+kt2
132 kt3=fac*h3(i)
133 kk11(j,k,i)=kk11(j,k,i)+kt3
134 kt4=fac*h4(i)
135 kl11(j,k,i)=kl11(j,k,i)+kt4
136 ENDDO
137 ENDDO
138 ENDDO
139 END IF !(FRIC>ZERO) THEN
140C
141 DO j=1,3
142 DO k=j,3
143 DO i=lft,llt
144 ki12(j,k,i)=-ki11(j,k,i)
145 kj12(j,k,i)=-kj11(j,k,i)
146 kk12(j,k,i)=-kk11(j,k,i)
147 kl12(j,k,i)=-kl11(j,k,i)
148 ENDDO
149 ENDDO
150 ENDDO
151 DO j=1,3
152 DO k=j+1,3
153 DO i=lft,llt
154 ki12(k,j,i)=-ki11(j,k,i)
155 kj12(k,j,i)=-kj11(j,k,i)
156 kk12(k,j,i)=-kk11(j,k,i)
157 kl12(k,j,i)=-kl11(j,k,i)
158 ENDDO
159 ENDDO
160 ENDDO
161C
162 DO i=lft,llt
163 off(i)=one
164 ENDDO
165C
166 RETURN
167 END
168!||====================================================================
169!|| i5frik3 ../engine/source/interfaces/inter3d/i5keg3.F
170!||--- called by ------------------------------------------------------
171!|| i5ke3 ../engine/source/interfaces/inter3d/i5ke3.F
172!||====================================================================
173 SUBROUTINE i5frik3(LFT ,LLT ,I_N ,I_E ,IPARI ,
174 2 X ,IRECT ,MSR ,NSV ,IRTL ,
175 3 CST ,IRTLO ,FRIC0 ,FRIC ,FREQ ,
176 4 FTSAV ,STFM ,TNJ ,XP ,YP ,
177 5 ZP ,N1 ,N2 ,N3 ,ANS ,
178 6 STIF )!,FXI ,FYI ,FZI ,FNI)
179C-----------------------------------------------
180C I m p l i c i t T y p e s
181C-----------------------------------------------
182#include "implicit_f.inc"
183#include "comlock.inc"
184C-----------------------------------------------
185C G l o b a l P a r a m e t e r s
186C-----------------------------------------------
187#include "mvsiz_p.inc"
188C-----------------------------------------------
189C C o m m o n B l o c k s
190C-----------------------------------------------
191#include "com08_c.inc"
192C-----------------------------------------------
193C D u m m y A r g u m e n t s
194C-----------------------------------------------
195 INTEGER IPARI(*),LFT, LLT, NFT,I_N(*),I_E(*)
196C REAL
197 my_real
198 . FRIC
199 INTEGER IRECT(4,*), MSR(*), NSV(*), IRTL(*), IRTLO(*)
200C REAL
201 my_real
202 . X(3,*), CST(2,*), FRIC0(3,*),TNJ(3,*), FREQ, FTSAV(*),STFM(*)
203 my_real, DIMENSION(MVSIZ), INTENT(IN) :: XP,YP,ZP,N1,N2,N3
204 my_real, DIMENSION(MVSIZ), INTENT(IN) :: ans
205 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: stif
206C-----------------------------------------------
207C L o c a l V a r i a b l e s
208C-----------------------------------------------
209 INTEGER I, IL, LOLD, JJ, NN, J3,
210 . j2, j1, ig, i3, i2, i1, k, ifq, mfrot,l
211 INTEGER NISKYL
212C REAL
213 my_real
214 . h(4), xx1(4), xx2(4), xx3(4),
215 . ss0, tt0, xc, econvt, alpha, alphi,
216 . yc, zc, xc0, yc0, zc0, sp, sm, tp, tm, ansx, ansy, ansz, fmax,
217 . stf, fti, fn, tn1, tn2, tn3, tn, dtm, xmu, vx,vy,vz,vv,v2,p,
218 . vv1,vv2,v21,dmu,aa
219 my_real, DIMENSION(MVSIZ) :: fxi,fyi,fzi,fni
220C-----------------------------------------------
221 DO i=lft,llt
222 l=i_e(i)
223 stif(i)=half*stfm(l)
224 ENDDO
225C
226 IF (fric==zero) RETURN
227C
228 DO 300 i=lft,llt
229 il=i_n(i)
230 lold=iabs(irtlo(il))
231 IF(lold==0)THEN
232C-------------------------------
233C POINT NON IMPACTE PRECEDEMENT:::diff than explicit
234C-------------------------------
235c TN1=ZERO
236c TN2=ZERO
237c TN3=ZERO
238 tn3=zero
239 tn=sqrt(n1(i)*n1(i)+n2(i)*n2(i))
240 IF(tn/=zero)THEN
241 tn2=-n1(i)/tn
242 tn1=n2(i)/tn
243 ELSE
244 tn2=zero
245 tn1=one
246 ENDIF
247 ELSE
248C-------------------------------
249C POINT IMPACTE PRECEDEMENT
250C-------------------------------
251 fni(i)=ans(i)*stif(i)
252 ss0=cst(1,il)
253 tt0=cst(2,il)
254 fxi(i)=fric0(1,il)
255 fyi(i)=fric0(2,il)
256 fzi(i)=fric0(3,il)
257C
258 xc=xp(i)
259 yc=yp(i)
260 zc=zp(i)
261 DO 100 jj=1,4
262 nn=msr(irect(jj,lold))
263 xx1(jj)=x(1,nn)
264 xx2(jj)=x(2,nn)
265 100 xx3(jj)=x(3,nn)
266 xc0=zero
267 yc0=zero
268 zc0=zero
269 sp=one+ss0
270 sm=one-ss0
271 tp= fourth*(one+tt0)
272 tm= fourth*(one-tt0)
273 h(1)=tm*sm
274 h(2)=tm*sp
275 h(3)=tp*sp
276 h(4)=tp*sm
277 DO 120 jj=1,4
278 xc0=xc0+h(jj)*xx1(jj)
279 yc0=yc0+h(jj)*xx2(jj)
280 120 zc0=zc0+h(jj)*xx3(jj)
281 ansx= (xc-xc0)
282 ansy= (yc-yc0)
283 ansz= (zc-zc0)
284C
285 fmax= -min(fric*fni(i),zero)
286C
287 stf=em01*stif(i)
288 fxi(i)=fxi(i) + ansx*stf
289 fyi(i)=fyi(i) + ansy*stf
290 fzi(i)=fzi(i) + ansz*stf
291 ifq = ipari(31)
292 IF (ifq>0) THEN
293 IF (ifq==3) freq = max(one,freq*dt12)
294 alpha = freq
295 alphi = one - alpha
296 k = 3*(il-1)
297 IF (fni(i)/=zero) THEN
298 fxi(i)= alpha*fxi(i) + alphi*ftsav(k+1)
299 fyi(i)= alpha*fyi(i) + alphi*ftsav(k+2)
300 fzi(i)= alpha*fzi(i) + alphi*ftsav(k+3)
301 ENDIF
302 ENDIF
303 fti=sqrt(fxi(i)*fxi(i)+fyi(i)*fyi(i)+fzi(i)*fzi(i))
304C
305 fn=fxi(i)*n1(i)+fyi(i)*n2(i)+fzi(i)*n3(i)
306 tn1=fxi(i)-n1(i)*fn
307 tn2=fyi(i)-n2(i)*fn
308 tn3=fzi(i)-n3(i)*fn
309 tn=sqrt(tn1*tn1+tn2*tn2+tn3*tn3)
310 IF(tn/=zero)THEN
311 tn1=tn1/tn
312 tn2=tn2/tn
313 tn3=tn3/tn
314 ELSE
315 tn3=zero
316 tn=sqrt(n1(i)*n1(i)+n2(i)*n2(i))
317 IF(tn/=zero)THEN
318 tn2=-n1(i)/tn
319 tn1=n2(i)/tn
320 ELSE
321 tn2=zero
322 tn1=one
323 ENDIF
324 ENDIF
325C
326 ENDIF
327 tnj(1,i)=tn1
328 tnj(2,i)=tn2
329 tnj(3,i)=tn3
330C
331 300 CONTINUE
332 RETURN
333 END
alpha
#define alpha
Definition eval.h:35
i5frik3
subroutine i5frik3(lft, llt, i_n, i_e, ipari, x, irect, msr, nsv, irtl, cst, irtlo, fric0, fric, freq, ftsav, stfm, tnj, xp, yp, zp, n1, n2, n3, ans, stif)
Definition i5keg3.F:179
i5keg3
subroutine i5keg3(lft, llt, fric, scalk, tnj, ki11, ki12, kj11, kj12, kk11, kk12, kl11, kl12, off, n1, n2, n3, stif, h1, h2, h3, h4)
Definition i5keg3.F:33
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21