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

Go to the source code of this file.

Functions/Subroutines

subroutine frictionparts_model_ortho (intfric, jlt, ipartfricsi, ipartfricmi, adparts_fric, nset, tabcoupleparts_fric, npartfric, tabparts_fric, tabcoef_fric, fric, viscf, frot_p, fric_coefs, fricc, viscffric, nty, mfrot, iorthfric, fric_coefs2, fricc2, viscffric2, ifricorth, nforth, nfisot, indexorth, indexisot, jlt_tied, irep_fricmi, dir_fricmi, ix3, ix4, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, ce_loc, dir1, dir2)
subroutine frictionparts_model_isot (intfric, jlt, ipartfricsi, ipartfricmi, adparts_fric, nset, tabcoupleparts_fric, npartfric, tabparts_fric, tabcoef_fric, fric, viscf, frot_p, fric_coefs, fricc, viscffric, nty, mfrot, iorthfric, ifric, jlt_tied, tint, tempi, npc, tf, temp, h1, h2, h3, h4, ix1, ix2, ix3, ix4, iform)

Function/Subroutine Documentation

◆ frictionparts_model_isot()

subroutine frictionparts_model_isot ( integer intfric,
integer jlt,
integer, dimension(*) ipartfricsi,
integer, dimension(*) ipartfricmi,
integer, dimension(npartfric+1) adparts_fric,
integer nset,
integer, dimension(nset) tabcoupleparts_fric,
integer npartfric,
integer, dimension(npartfric) tabparts_fric,
tabcoef_fric,
fric,
viscf,
frot_p,
fric_coefs,
fricc,
viscffric,
integer nty,
integer mfrot,
integer iorthfric,
integer ifric,
integer jlt_tied,
tint,
tempi,
integer, dimension(*) npc,
tf,
temp,
h1,
h2,
h3,
h4,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer iform )

Definition at line 342 of file frictionparts_model.F.

350
351C-----------------------------------------------
352C M o d u l e s
353C-----------------------------------------------
354
355C-----------------------------------------------
356C I m p l i c i t T y p e s
357C-----------------------------------------------
358#include "implicit_f.inc"
359#include "comlock.inc"
360C-----------------------------------------------
361C G l o b a l P a r a m e t e r s
362C-----------------------------------------------
363#include "mvsiz_p.inc"
364C-----------------------------------------------
365C D u m m y A r g u m e n t s
366C-----------------------------------------------
367 INTEGER INTFRIC,JLT,NFRIC_P ,NSET ,NPARTFRIC ,NTY ,MFROT ,IORTHFRIC ,IFRIC ,
368 . JLT_TIED ,IFORM
369 INTEGER IPARTFRICSI(*), IPARTFRICMI(*), ADPARTS_FRIC(NPARTFRIC+1),
370 . TABCOUPLEPARTS_FRIC(NSET),TABPARTS_FRIC(NPARTFRIC) ,NPC(*) ,
371 . IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ)
372 my_real
373 . viscf ,fric , tint,
374 . fric_coefs(mvsiz,10),tabcoef_fric(12*(nset+1)),fricc(*), viscffric(*),
375 . tf(*) , temp(*) ,tempi(mvsiz) ,h1(mvsiz) ,h2(mvsiz) ,h3(mvsiz) ,h4(mvsiz) ,
376 . frot_p(10)
377C-----------------------------------------------
378C L o c a l V a r i a b l e s
379C-----------------------------------------------
380 INTEGER I ,J ,K ,IPS ,IPM ,IP ,IPMID ,ADRI ,ADRF ,ADRCOEF ,IPSL ,IPML ,IPI ,IPF ,
381 . LENC
382 my_real adr ,thi ,tm ,dydx
383 my_real
384 . finter,total
385 EXTERNAL finter
386C
387C-----------------------------------------------
388 IF(mfrot ==0 ) THEN
389 lenc =2
390 ELSE
391 lenc = 8
392 ENDIF
393
394 IF (intfric == 0) THEN
395
396 DO i=1,jlt-jlt_tied
397 IF(mfrot/=0) fric_coefs(i,1:10) = frot_p(1:10)
398 viscffric(i) = viscf
399 fricc(i) = fric
400 ENDDO
401
402 IF (ifric > 0) THEN ! Friction coef = f(Temp)
403 IF( iform == 0) THEN
404 DO i=1,jlt-jlt_tied
405 thi = (tempi(i)+tint)/2
406 fricc(i) = fricc(i)*finter(ifric,thi,npc,tf,dydx)
407 ENDDO
408 ELSE
409 DO i=1,jlt-jlt_tied
410 tm = h1(i)*temp(ix1(i)) + h2(i)*temp(ix2(i))
411 . + h3(i)*temp(ix3(i)) + h4(i)*temp(ix4(i))
412 thi = (tempi(i)+tm)/2
413 fricc(i) = fricc(i)*finter(ifric,thi,npc,tf,dydx)
414 ENDDO
415 ENDIF
416
417 ENDIF
418
419
420 ELSE
421C--------Default coefficients define in friction interface
422 DO i=1,jlt-jlt_tied
423 fricc(i) = tabcoef_fric(1)
424 viscffric(i) = tabcoef_fric(2)
425 IF(mfrot/=0) THEN
426 DO j=1,6
427 fric_coefs(i,j) = tabcoef_fric(j+2)
428 ENDDO
429 ENDIF
430 ENDDO
431 IF(nty == 24.OR.nty == 25.OR.nty==21) THEN
432 DO i=1,jlt-jlt_tied
433 viscffric(i) = zero
434 ENDDO
435 ENDIF
436C
437 DO i=1,jlt-jlt_tied
438 ipsl = ipartfricsi(i)
439 ipml = ipartfricmi(i)
440c
441 IF(ipsl /= 0) THEN
442 ips = tabparts_fric(ipsl) ! PART of secnd node
443 ELSE
444 ips = 0
445 ENDIF
446 IF(ipml /= 0) THEN
447 ipm = tabparts_fric(ipml) ! PART of main node
448 ELSE
449 ipm = 0
450 ENDIF
451c
452 IF(ips/=0.AND.ipm/=0) THEN
453 IF(ipsl > ipml ) THEN
454 ip = ips
455 ips = ipm
456 ipm = ip
457c
458 ip = ipsl
459 ipsl = ipml
460 ipml = ip
461 ENDIF
462
463 adri = adparts_fric(ipsl) !Adress of First local part associated to IPS
464c
465 IF (adri /= 0) THEN
466 adrf = adparts_fric(ipsl+1)-1 !Adress of Last part associated to IPS
467C
468C--------Looking for Adress of parts couple (IPS,IPM) in TABPARTSFRIC
469 adrcoef = 0
470C
471 IF(adri == adrf ) THEN
472 ipi = tabcoupleparts_fric(adri)
473 IF(ipi == ipm) THEN
474 adrcoef = adri
475 ELSE
476 adrcoef = 0
477 ENDIF
478 ELSE
479 DO WHILE ((adrf-adri) >= 1)
480 adr = (adrf-adri)*half
481 k = adri + nint(adr)
482 ipmid = tabcoupleparts_fric(k)
483 ipf = tabcoupleparts_fric(adrf)
484 ipi = tabcoupleparts_fric(adri)
485 IF(ipmid == ipm) THEN
486 adrcoef = k
487 EXIT
488 ELSEIF(ipi == ipm) THEN
489 adrcoef = adri
490 EXIT
491 ELSEIF(ipf == ipm) THEN
492 adrcoef = adrf
493 EXIT
494 ELSEIF (ipmid < ipm) THEN
495 adri = k + 1
496 ELSEIF (ipmid > ipm) THEN
497 adrf = k - 1
498 ENDIF
499 ENDDO
500 ENDIF
501
502C-----Selecting corresponding friction coefs ------------------
503
504 IF(iorthfric==0) THEN
505 IF(adrcoef /= 0) THEN
506 fricc(i) = tabcoef_fric(lenc*adrcoef+1)
507 viscffric(i) = tabcoef_fric(lenc*adrcoef+2)
508 IF(mfrot > 0 ) THEN
509 DO j=1,6
510 fric_coefs(i,j) = tabcoef_fric(lenc*adrcoef+j+2)
511 ENDDO
512 ENDIF
513 ENDIF
514 ELSE
515 IF(adrcoef /= 0) THEN
516 fricc(i) = tabcoef_fric(lenc+2*lenc*(adrcoef-1)+1)
517 viscffric(i) = tabcoef_fric(lenc+2*lenc*(adrcoef-1)+2)
518 IF(mfrot > 0 ) THEN
519 DO j=1,6
520 fric_coefs(i,j) = tabcoef_fric(lenc+2*lenc*adrcoef+j+2)
521 ENDDO
522 ENDIF
523 ENDIF
524 ENDIF
525 ENDIF
526 ENDIF
527
528 ENDDO
529 ENDIF
530
531
532C
533 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ frictionparts_model_ortho()

subroutine frictionparts_model_ortho ( integer intfric,
integer jlt,
integer, dimension(mvsiz) ipartfricsi,
integer, dimension(mvsiz) ipartfricmi,
integer, dimension(npartfric+1) adparts_fric,
integer nset,
integer, dimension(nset ) tabcoupleparts_fric,
integer npartfric,
integer, dimension(npartfric) tabparts_fric,
tabcoef_fric,
fric,
viscf,
frot_p,
fric_coefs,
fricc,
viscffric,
integer nty,
integer mfrot,
integer iorthfric,
fric_coefs2,
fricc2,
viscffric2,
integer, dimension(nset) ifricorth,
integer nforth,
integer nfisot,
integer, dimension(mvsiz) indexorth,
integer, dimension(mvsiz) indexisot,
integer jlt_tied,
integer, dimension(mvsiz) irep_fricmi,
dir_fricmi,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
x1,
y1,
z1,
x2,
y2,
z2,
x3,
y3,
z3,
x4,
y4,
z4,
integer, dimension(mvsiz) ce_loc,
dir1,
dir2 )

Definition at line 32 of file frictionparts_model.F.

43
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE tri7box
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 D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER INTFRIC,JLT,NFRIC_P ,NSET ,NPARTFRIC ,NTY ,MFROT ,IORTHFRIC ,NFORTH ,
61 . NFISOT ,JLT_TIED
62 INTEGER IPARTFRICSI(MVSIZ), IPARTFRICMI(MVSIZ), ADPARTS_FRIC(NPARTFRIC+1),
63 . TABCOUPLEPARTS_FRIC(NSET ),TABPARTS_FRIC(NPARTFRIC) ,INDEXORTH(MVSIZ),
64 . INDEXISOT(MVSIZ),IFRICORTH(NSET),IREP_FRICMI(MVSIZ),IX3(MVSIZ),IX4(MVSIZ),
65 . CE_LOC(MVSIZ)
66
67 my_real
68 . viscf ,fric ,
69 . fric_coefs(mvsiz,10),tabcoef_fric(*),fricc(mvsiz), viscffric(mvsiz),
70 . frot_p(10),fricc2(mvsiz), viscffric2(mvsiz),fric_coefs2(mvsiz,10),dir1(mvsiz,3),
71 . dir2(mvsiz,3),dir_fricmi(mvsiz,2),
72 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
73 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
74 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz)
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I ,J ,K ,IPS ,IPM ,IP ,IPMID ,ADRI ,ADRF ,ADRCOEF ,IPSL ,IPML ,IPI ,IPF ,
79 . L , IREP ,IORTH,NI,NN ,LENC
80 my_real adr ,e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,rx ,ry ,rz ,sx ,sy ,sz ,
81 . suma ,s1 ,s2 ,aa ,bb ,v1 ,v2 ,v3 ,vr ,vs
82C
83C-----------------------------------------------
84 nforth = 0
85 nfisot = 0
86
87C--------Default coefficients define in friction interface
88 DO i=1,jlt-jlt_tied
89 fricc(i) = tabcoef_fric(1)
90 viscffric(i) = tabcoef_fric(2)
91 fricc2(i) = zero
92 viscffric2(i) = zero
93 ENDDO
94 IF(mfrot ==0 ) THEN
95 lenc =2
96 ELSE
97 lenc = 8
98 ENDIF
99 IF(mfrot/=0) THEN
100 DO i=1,jlt-jlt_tied
101 DO j=1,6
102 fric_coefs(i,j) = tabcoef_fric(j+2)
103 fric_coefs2(i,j) = zero
104 ENDDO
105 ENDDO
106 ENDIF
107
108 IF(nty == 24.OR.nty == 25) THEN
109 DO i=1,jlt-jlt_tied
110 viscffric(i) = zero
111 ENDDO
112 ENDIF
113C
114 DO i=1,jlt-jlt_tied
115 ipsl = ipartfricsi(i)
116 ipml = ipartfricmi(i)
117c
118 IF(ipsl /= 0) THEN
119 ips = tabparts_fric(ipsl) ! PART of secnd node
120 ELSE
121 ips = 0
122 ENDIF
123 IF(ipml /= 0) THEN
124 ipm = tabparts_fric(ipml) ! PART of main node
125 ELSE
126 ipm = 0
127 ENDIF
128c
129 IF(ips/=0.AND.ipm/=0) THEN
130 IF(ipsl > ipml ) THEN
131 ip = ips
132 ips = ipm
133 ipm = ip
134c
135 ip = ipsl
136 ipsl = ipml
137 ipml = ip
138 ENDIF
139
140 adri = adparts_fric(ipsl) !Adress of First local part associated to IP
141c
142 IF (adri /= 0) THEN
143 adrf = adparts_fric(ipsl+1)-1 !Adress of Last part associated to IPS
144C
145C--------Looking for Adress of parts couple (IPS,IPM) in TABPARTSFRIC
146 adrcoef = 0
147C
148 IF(adri == adrf ) THEN
149 ipi = tabcoupleparts_fric(adri)
150 IF(ipi == ipm) THEN
151 adrcoef = adri
152 ELSE
153 adrcoef = 0
154 ENDIF
155 ELSE
156 DO WHILE ((adrf-adri) >= 1)
157 adr = (adrf-adri)*half
158 k = adri + nint(adr)
159 ipmid = tabcoupleparts_fric(k)
160 ipf = tabcoupleparts_fric(adrf)
161 ipi = tabcoupleparts_fric(adri)
162 IF(ipmid == ipm) THEN
163 adrcoef = k
164 EXIT
165 ELSEIF(ipi == ipm) THEN
166 adrcoef = adri
167 EXIT
168 ELSEIF(ipf == ipm) THEN
169 adrcoef = adrf
170 EXIT
171 ELSEIF (ipmid < ipm) THEN
172 adri = k + 1
173 ELSEIF (ipmid > ipm) THEN
174 adrf = k - 1
175 ENDIF
176 ENDDO
177 ENDIF
178
179C-----Selecting corresponding friction coefs ------------------
180 IF(adrcoef /= 0) THEN
181c
182 iorth = ifricorth(adrcoef)
183 l= ce_loc(i)
184 irep = irep_fricmi(i)
185c
186 IF(iorth > 0 .AND.irep /=10 ) THEN
187 nforth = nforth +1
188 indexorth(nforth) = i
189c
190 fricc(i) = tabcoef_fric(lenc+2*lenc*(adrcoef-1)+1)
191 fricc2(i)= tabcoef_fric(2*lenc*adrcoef+1)
192 IF(nty == 24.OR.nty == 25 ) THEN
193 viscffric(i) = zero
194 viscffric2(i) = zero
195 ELSE
196 viscffric(i) = tabcoef_fric(lenc+2*lenc*(adrcoef-1)+2)
197 viscffric2(i) = tabcoef_fric(2*lenc*adrcoef+2)
198 ENDIF
199 IF (mfrot > 0) THEN
200 DO j=1,6
201 fric_coefs(i,j) = tabcoef_fric(lenc+2*lenc*adrcoef+j+2)
202 fric_coefs2(i,j) = tabcoef_fric(2*lenc*adrcoef+j+2)
203 ENDDO
204 ENDIF
205 ELSE
206 nfisot = nfisot +1
207 indexisot(nfisot) = i
208C
209 fricc(i) = tabcoef_fric(lenc+2*lenc*(adrcoef-1)+1)
210 IF(nty == 24.OR.nty == 25 ) THEN
211 viscffric(i) = zero
212 ELSE
213 viscffric(i) = tabcoef_fric(lenc+2*lenc*(adrcoef-1)+2)
214 ENDIF
215 IF (mfrot > 0) THEN
216 DO j=1,6
217 fric_coefs(i,j) = tabcoef_fric(2*lenc*adrcoef+j+2)
218 ENDDO
219 ENDIF
220 ENDIF
221 ELSE ! ADRCOEF
222 nfisot = nfisot +1
223 indexisot(nfisot) = i
224 ENDIF
225c
226
227 ELSE ! ADRI ==0
228
229 nfisot = nfisot +1
230 indexisot(nfisot) = i
231 ENDIF
232
233 ELSE
234
235 nfisot = nfisot +1
236 indexisot(nfisot) = i
237 ENDIF
238
239 ENDDO
240
241C----Orthotropic Friction : global orthotropic axes computation
242 IF(nforth > 0 ) THEN
243 DO k=1,nforth
244 i = indexorth(k )
245 l= ce_loc(i)
246C--- isoparametric (material) axes
247 IF (ix3(i) /= ix4(i)) THEN
248C--- shell 4N
249 e1x= x2(i) + x3(i) - x1(i) - x4(i)
250 e1y= y2(i) + y3(i) - y1(i) - y4(i)
251 e1z= z2(i) + z3(i) - z1(i) - z4(i)
252 e2x= x3(i) + x4(i) - x1(i) - x2(i)
253 e2y= y3(i) + y4(i) - y1(i) - y2(i)
254 e2z= z3(i) + z4(i) - z1(i) - z2(i)
255
256 ELSE
257C--- shell 3N
258 e1x= x2(i) - x1(i)
259 e1y= y2(i) - y1(i)
260 e1z= z2(i) - z1(i)
261 e2x= x3(i) - x1(i)
262 e2y= y3(i) - y1(i)
263 e2z= z3(i) - z1(i)
264 ENDIF
265 rx = e1x
266 ry = e1y
267 rz = e1z
268 sx = e2x
269 sy = e2y
270 sz = e2z
271c
272 e3x = e1y*e2z-e1z*e2y
273 e3y = e1z*e2x-e1x*e2z
274 e3z = e1x*e2y-e1y*e2x
275
276 suma = e3x*e3x+e3y*e3y+e3z*e3z
277 suma = one/max(sqrt(suma),em20)
278 e3x = e3x*suma
279 e3y = e3y*suma
280 e3z = e3z*suma
281C
282 s1 = e1x*e1x+e1y*e1y+e1z*e1z
283 s2 = e2x*e2x+e2y*e2y+e2z*e2z
284 suma = sqrt(s1/s2)
285 e1x = e1x + (e2y *e3z-e2z*e3y)*suma
286 e1y = e1y + (e2z *e3x-e2x*e3z)*suma
287 e1z = e1z + (e2x *e3y-e2y*e3x)*suma
288C
289 suma = e1x*e1x+e1y*e1y+e1z*e1z
290 suma = one/max(sqrt(suma),em20)
291 e1x = e1x*suma
292 e1y = e1y*suma
293 e1z = e1z*suma
294C
295 e2x = e3y * e1z - e3z * e1y
296 e2y = e3z * e1x - e3x * e1z
297 e2z = e3x * e1y - e3y * e1x
298
299C--- Projection of orthotropic axes on global system
300 aa = dir_fricmi(i,1)
301 bb = dir_fricmi(i,2)
302 irep = irep_fricmi(i)
303
304 IF(irep == 1) THEN
305 v1 = aa*rx + bb*sx
306 v2 = aa*ry + bb*sy
307 v3 = aa*rz + bb*sz
308 vr = v1*e1x+ v2*e1y + v3*e1z
309 vs = v1*e2x+ v2*e2y + v3*e2z
310 suma=max(sqrt(vr*vr + vs*vs) , em20)
311 aa = vr/suma
312 bb = vs/suma
313 ENDIF
314
315 dir1(i,1) = aa*e1x+bb*e2x
316 dir1(i,2) = aa*e1y+bb*e2y
317 dir1(i,3) = aa*e1z+bb*e2z
318
319 dir2(i,1) = aa*e2x-bb*e1x
320 dir2(i,2) = aa*e2y-bb*e1y
321 dir2(i,3) = aa*e2z-bb*e1z
322
323 ENDDO
324 ENDIF
325
326C
327 RETURN
max
#define max(a, b)
Definition macros.h:21