OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i5keg3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i5keg3 (lft, llt, fric, scalk, tnj, ki11, ki12, kj11, kj12, kk11, kk12, kl11, kl12, off, n1, n2, n3, stif, h1, h2, h3, h4)
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)

Function/Subroutine Documentation

◆ i5frik3()

subroutine i5frik3 ( integer lft,
integer llt,
integer, dimension(*) i_n,
integer, dimension(*) i_e,
integer, dimension(*) ipari,
x,
integer, dimension(4,*) irect,
integer, dimension(*) msr,
integer, dimension(*) nsv,
integer, dimension(*) irtl,
cst,
integer, dimension(*) irtlo,
fric0,
fric,
freq,
ftsav,
stfm,
tnj,
intent(in) xp,
intent(in) yp,
intent(in) zp,
intent(in) n1,
intent(in) n2,
intent(in) n3,
intent(in) ans,
intent(inout) stif )

Definition at line 173 of file i5keg3.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ i5keg3()

subroutine i5keg3 ( integer lft,
integer llt,
fric,
scalk,
tnj,
ki11,
ki12,
kj11,
kj12,
kk11,
kk12,
kl11,
kl12,
off,
intent(in) n1,
intent(in) n2,
intent(in) n3,
intent(in) stif,
intent(in) h1,
intent(in) h2,
intent(in) h3,
intent(in) h4 )

Definition at line 28 of file i5keg3.F.

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