OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
frictionparts_model.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!|| frictionparts_model_ortho ../engine/source/interfaces/int07/frictionparts_model.F
25!||--- called by ------------------------------------------------------
26!|| i24mainf ../engine/source/interfaces/int24/i24main.F
27!|| i25mainf ../engine/source/interfaces/int25/i25mainf.F
28!|| i7mainf ../engine/source/interfaces/int07/i7mainf.F
29!||--- uses -----------------------------------------------------
30!|| tri7box ../engine/share/modules/tri7box.F
31!||====================================================================
32 SUBROUTINE frictionparts_model_ortho(
33 1 INTFRIC , JLT ,IPARTFRICSI ,IPARTFRICMI ,ADPARTS_FRIC ,
34 2 NSET , TABCOUPLEPARTS_FRIC,NPARTFRIC ,TABPARTS_FRIC ,TABCOEF_FRIC ,
35 3 FRIC , VISCF , FROT_P ,FRIC_COEFS , FRICC ,
36 4 VISCFFRIC , NTY , MFROT ,IORTHFRIC , FRIC_COEFS2,
37 5 FRICC2 ,VISCFFRIC2 , IFRICORTH ,NFORTH , NFISOT ,
38 6 INDEXORTH ,INDEXISOT ,JLT_TIED ,IREP_FRICMI , DIR_FRICMI ,
39 7 IX3 ,IX4 ,X1 ,Y1 , Z1 ,
40 8 X2 ,Y2 ,Z2 ,X3 ,Y3 ,
41 9 Z3 ,X4 ,Y4 ,Z4 ,CE_LOC ,
42 A DIR1 ,DIR2 )
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
328 END
329
330
331!||====================================================================
332!|| frictionparts_model_isot ../engine/source/interfaces/int07/frictionparts_model.f
333!||--- called by ------------------------------------------------------
334!|| i11mainf ../engine/source/interfaces/int11/i11mainf.F
335!|| i21mainf ../engine/source/interfaces/int21/i21mainf.F
336!|| i24mainf ../engine/source/interfaces/int24/i24main.F
337!|| i25mainf ../engine/source/interfaces/int25/i25mainf.F
338!|| i7mainf ../engine/source/interfaces/int07/i7mainf.F
339!||--- calls -----------------------------------------------------
340!|| finter ../engine/source/tools/curve/finter.F
341!||====================================================================
342 SUBROUTINE frictionparts_model_isot(
343 1 INTFRIC , JLT ,IPARTFRICSI ,IPARTFRICMI ,ADPARTS_FRIC ,
344 2 NSET , TABCOUPLEPARTS_FRIC,NPARTFRIC ,TABPARTS_FRIC ,TABCOEF_FRIC ,
345 3 FRIC , VISCF , FROT_P ,FRIC_COEFS ,FRICC ,
346 4 VISCFFRIC , NTY , MFROT ,IORTHFRIC ,IFRIC ,
347 5 JLT_TIED , TINT ,TEMPI ,NPC ,TF ,
348 6 TEMP , H1 ,H2 ,H3 ,H4 ,
349 7 IX1 , IX2 ,IX3 ,IX4 ,IFORM )
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
534 END
535
536
537
frictionparts_model_ortho
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)
Definition frictionparts_model.F:43
frictionparts_model_isot
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)
Definition frictionparts_model.F:350
max
#define max(a, b)
Definition macros.h:21