OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2_dtn.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!|| i2_dtn ../starter/source/interfaces/inter3d1/i2_dtn.F
25!||--- called by ------------------------------------------------------
26!|| inintr2 ../starter/source/interfaces/inter3d1/inintr2.F
27!||--- calls -----------------------------------------------------
28!|| i2_dtn_0 ../starter/source/interfaces/inter3d1/i2_dtn.F
29!|| i2_dtn_1 ../starter/source/interfaces/inter3d1/i2_dtn.F
30!|| i2_dtn_25 ../starter/source/interfaces/inter3d1/i2_dtn.F
31!||--- uses -----------------------------------------------------
32!||====================================================================
33 SUBROUTINE i2_dtn(X,INTBUF_TAB,IPARI,STIFN,MS,IN,N,ILEV)
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE intbufdef_mod
38C=======================================================================
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42#include "com01_c.inc"
43#include "com04_c.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "param_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER IPARI(NPARI,*),NSN,N,ILEV
52 my_real x(3,*),stifn(*),ms(*),in(*)
53 TYPE(intbuf_struct_) INTBUF_TAB(*)
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER I,NI
58C=======================================================================
59
60 IF (((ilev==1).OR.(ilev==3)).AND.(iroddl==1)) THEN
61 CALL i2_dtn_1(x,intbuf_tab(n)%IRECTM,intbuf_tab(n)%NSV,intbuf_tab(n)%IRTLM,
62 . ipari(1,n),stifn, stifn(numnod+1),ms,in,ilev)
63 ELSEIF (ilev==25) THEN
64 CALL i2_dtn_25(x,intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,intbuf_tab(n)%NSV,intbuf_tab(n)%IRTLM,
65 . ipari(1,n),stifn,intbuf_tab(n)%SPENALTY,intbuf_tab(n)%VARIABLES(14))
66 ELSE
67 CALL i2_dtn_0(intbuf_tab(n)%IRECTM,intbuf_tab(n)%CSTS,intbuf_tab(n)%CSTS_BIS,intbuf_tab(n)%NSV,
68 . intbuf_tab(n)%IRTLM ,ipari(1,n), stifn,
69 . ms)
70 ENDIF
71C-----------
72 RETURN
73 END
74
75!||====================================================================
76!|| i2_dtn_0 ../starter/source/interfaces/inter3d1/i2_dtn.F
77!||--- called by ------------------------------------------------------
78!|| i2_dtn ../starter/source/interfaces/inter3d1/i2_dtn.F
79!||====================================================================
80 SUBROUTINE i2_dtn_0(IRECT ,CRST ,CSTS_BIS, NSV ,
81 2 IRTL ,IPARI , STIFN ,
82 2 MS)
83C-----------------------------------------------
84C M o d u l e s
85C-----------------------------------------------
86C============================================================================
87C I m p l i c i t T y p e s
88C-----------------------------------------------
89#include "implicit_f.inc"
90#include "com01_c.inc"
91C-----------------------------------------------
92C D u m m y A r g u m e n t s
93C-----------------------------------------------
94 INTEGER IRECT(4,*), NSV(*),IRTL(*), IPARI(*)
95 my_real CRST(2,*),STIFN(*),MS(*),CSTS_BIS(2,*)
96C-----------------------------------------------
97C L o c a l V a r i a b l e s
98C-----------------------------------------------
99 INTEGER II,I,J,JJ,L,IX1,IX2,IX3,IX4,NIR,NRTM,NSN,NMN,K
100 my_real
101 . ss,st,sp,sm,tp,h(4),h2(4),tm
102C=======================================================================
103 nrtm = ipari(4)
104 nsn = ipari(5)
105 nmn = ipari(6)
106C
107 DO ii=1,nsn
108C
109 i = nsv(ii)
110 l = irtl(ii)
111C
112 ix1 = irect(1,l)
113 ix2 = irect(2,l)
114 ix3 = irect(3,l)
115 ix4 = irect(4,l)
116C
117 ss=crst(1,ii)
118 st=crst(2,ii)
119 sp=one + ss
120 sm=one - ss
121 tp=fourth*(one + st)
122 tm=fourth*(one - st)
123 h(1)=tm*sm
124 h(2)=tm*sp
125 h(3)=tp*sp
126 h(4)=tp*sm
127C
128 ss=csts_bis(1,ii)
129 st=csts_bis(2,ii)
130 sp=one + ss
131 sm=one - ss
132 tp=fourth*(one + st)
133 tm=fourth*(one - st)
134 h2(1)=tm*sm
135 h2(2)=tm*sp
136 h2(3)=tp*sp
137 h2(4)=tp*sm
138C
139 IF (n2d/=0) THEN
140 nir = 2
141 ELSEIF(ix3 == ix4) THEN
142 h(3) = h(3) + h(4)
143 h(4) = zero
144 h2(3) = h2(3) + h2(4)
145 h2(4) = zero
146 nir=3
147 ELSE
148 nir=4
149 ENDIF
150C
151 DO jj=1,nir
152 j=irect(jj,l)
153 ms(j)=ms(j)+ms(i)*h2(jj)
154 stifn(j)=stifn(j)+stifn(i)*abs(h(jj))
155 ENDDO
156C
157 stifn(i)=zero
158 ms(i)=zero
159C
160 ENDDO
161C
162C-----------
163 RETURN
164 END
165
166!||====================================================================
167!|| i2_dtn_1 ../starter/source/interfaces/inter3d1/i2_dtn.F
168!||--- called by ------------------------------------------------------
169!|| i2_dtn ../starter/source/interfaces/inter3d1/i2_dtn.F
170!||====================================================================
171 SUBROUTINE i2_dtn_1(X,IRECT , NSV ,IRTL ,
172 2 IPARI, STIFN, STIFR, MS, IN,ILEV)
173C-----------------------------------------------
174C M o d u l e s
175C-----------------------------------------------
176C============================================================================
177C I m p l i c i t T y p e s
178C-----------------------------------------------
179#include "implicit_f.inc"
180#include "com01_c.inc"
181C-----------------------------------------------
182C D u m m y A r g u m e n t s
183C-----------------------------------------------
184 INTEGER IRECT(4,*), NSV(*),IRTL(*), IPARI(*),ILEV
185 my_real X(3,*),STIFN(*),STIFR(*), MS(*),IN(*)
186C-----------------------------------------------
187C L o c a l V a r i a b l e s
188C-----------------------------------------------
189 INTEGER II,I,J,JJ,L,J1,J2,J3,J4,NIR,NRTM,NSN,NMN
190 my_real
191 . X1,X2,X3,X4,Y1,Y2,Y3,Y4,Z1,Z2,Z3,Z4,XS,YS,ZS,X0,Y0,Z0,
192 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
193 . x12,x22,x32,x42,y12,y22,y32,y42,z12,z22,z32,z42,
194 . a1,a2,a3,b1,b2,b3,c1,c2,c3,mr,mrx,mry,mrz,inx,iny,inz,stf,fact,
195 . det,xmsi
196C=======================================================================
197 nrtm = ipari(4)
198 nsn = ipari(5)
199 nmn = ipari(6)
200C
201 DO ii=1,nsn
202C
203 i = nsv(ii)
204 l = irtl(ii)
205C
206 j1=irect(1,l)
207 j2=irect(2,l)
208 j3=irect(3,l)
209 j4=irect(4,l)
210C
211 x1=x(1,j1)
212 y1=x(2,j1)
213 z1=x(3,j1)
214 x2=x(1,j2)
215 y2=x(2,j2)
216 z2=x(3,j2)
217 x3=x(1,j3)
218 y3=x(2,j3)
219 z3=x(3,j3)
220 x4=x(1,j4)
221 y4=x(2,j4)
222 z4=x(3,j4)
223 x0=fourth*(x1+x2+x3+x4)
224 y0=fourth*(y1+y2+y3+y4)
225 z0=fourth*(z1+z2+z3+z4)
226 x1=x1-x0
227 y1=y1-y0
228 z1=z1-z0
229 x2=x2-x0
230 y2=y2-y0
231 z2=z2-z0
232 x3=x3-x0
233 y3=y3-y0
234 z3=z3-z0
235 x4=x4-x0
236 y4=y4-y0
237 z4=z4-z0
238 xs=x(1,i)-x0
239 ys=x(2,i)-y0
240 zs=x(3,i)-z0
241C
242 x12=x1*x1
243 x22=x2*x2
244 x32=x3*x3
245 x42=x4*x4
246 y12=y1*y1
247 y22=y2*y2
248 y32=y3*y3
249 y42=y4*y4
250 z12=z1*z1
251 z22=z2*z2
252 z32=z3*z3
253 z42=z4*z4
254 xx=x12 + x22 + x32 + x42
255 yy=y12 + y22 + y32 + y42
256 zz=z12 + z22 + z32 + z42
257 xy=x1*y1 + x2*y2 + x3*y3 + x4*y4
258 yz=y1*z1 + y2*z2 + y3*z3 + y4*z4
259 zx=z1*x1 + z2*x2 + z3*x3 + z4*x4
260 zzz=xx+yy
261 xxx=yy+zz
262 yyy=zz+xx
263 xy2=xy*xy
264 yz2=yz*yz
265 zx2=zx*zx
266 det= xxx*yyy*zzz - xxx*yz2 - yyy*zx2 - zzz*xy2 - two*xy*yz*zx
267 det=one/max(det,em20)
268 b1=zzz*yyy-yz2
269 b2=xxx*zzz-zx2
270 b3=yyy*xxx-xy2
271 c3=zzz*xy+yz*zx
272 c1=xxx*yz+zx*xy
273 c2=yyy*zx+xy*yz
274C
275 IF (iroddl == 1) THEN
276 inx= in(i) + ms(i)*(xs*xs+ys*ys+zs*zs)
277 ELSE
278 inx= ms(i)*(xs*xs+ys*ys+zs*zs)
279 ENDIF
280C
281 mrx = (b1+c3+c2)
282 mry = (b2+c1+c3)
283 mrz = (b3+c2+c1)
284 mr=det*inx*max(mrx,mry,mrz)
285C
286 fact = one
287 IF (iroddl==1) THEN
288 IF (in(j1)>zero.AND.in(j2)>zero.AND.in(j3)>zero.AND.in(j4)>zero) THEN
289C-- Inertie transmise sous forme d'inertie
290 fact = zero
291 ENDIF
292 ENDIF
293C
294 xmsi = ms(i)
295 IF(ilev==1)THEN
296 xmsi=fourth*xmsi+mr
297 ELSEIF(ilev==3)THEN
298 xmsi=max(fourth*xmsi,mr)
299 ENDIF
300C
301 ms(j1)=ms(j1)+xmsi
302 ms(j2)=ms(j2)+xmsi
303 ms(j3)=ms(j3)+xmsi
304 ms(j4)=ms(j4)+xmsi
305C
306 stf = fourth*stifn(i) + det*max(mrx,mry,mrz)*(stifr(i)+stifn(i)*(xs*xs+ys*ys+zs*zs))
307C
308 stifn(j1)=stifn(j1) + stf
309 stifn(j2)=stifn(j2) + stf
310 stifn(j3)=stifn(j3) + stf
311 stifn(j4)=stifn(j4) + stf
312C
313 IF (iroddl==1) THEN
314 in(j1)=in(j1)+inx*fourth*(one-fact)
315 in(j2)=in(j2)+inx*fourth*(one-fact)
316 in(j3)=in(j3)+inx*fourth*(one-fact)
317 in(j4)=in(j4)+inx*fourth*(one-fact)
318 ENDIF
319C
320 ms(i)=zero
321 stifn(i)=em20
322C
323 IF (iroddl==1) THEN
324 in(i)=zero
325 stifr(i)=em20
326 ENDIF
327C
328 ENDDO
329C
330C-----------
331 RETURN
332 END
333C
334!||====================================================================
335!|| i2_dtn_25 ../starter/source/interfaces/inter3d1/i2_dtn.F
336!||--- called by ------------------------------------------------------
337!|| i2_dtn ../starter/source/interfaces/inter3d1/i2_dtn.F
338!||--- calls -----------------------------------------------------
339!||====================================================================
340 SUBROUTINE i2_dtn_25(X,IRECT ,CRST ,NSV ,IRTL,
341 2 IPARI,STIFN,STFN,VISC)
342C-----------------------------------------------
343C I m p l i c i t T y p e s
344C-----------------------------------------------
345#include "implicit_f.inc"
346C-----------------------------------------------
347C D u m m y A r g u m e n t s
348C-----------------------------------------------
349 INTEGER IRECT(4,*),NSV(*),IRTL(*),IPARI(*)
350 my_real X(3,*),STIFN(*),STFN(*),CRST(2,*),VISC
351C-----------------------------------------------
352C L o c a l V a r i a b l e s
353C-----------------------------------------------
354 INTEGER NIR,I,J,II,JJ,L,W,NN,KK,LLT,
355 . IX1, IX2, IX3, IX4,NSVG,NSN
356 my_real
357 . S,T,SP,SM,TP,TM,E1X,E1Y,E1Z,E2X,E2Y,E2Z,E3X,E3Y,E3Z,
358 . xsm,ysm,zsm,xm,ym,zm,x1,x2,x3,x4,y1,y2,y3,y4,z1,z2,z3,z4,x0,y0,z0,xs,ys,zs,stifm,
359 . stf,str,stbrk
360 my_real
361 . h(4),rx(4),ry(4),rz(4),rm(3),rs(3),stif, vis
362 my_real
363 . len2,fac_triang,irot,skew(9),tt,bid,bid3(3),bid4(4,3)
364C=======================================================================
365 nsn = ipari(5)
366C
367 bid = zero
368 bid3(1:3) = zero
369 bid4(1:4,1:3) = zero
370 tt = zero
371C
372 DO ii=1,nsn
373C
374 i = nsv(ii)
375 l = irtl(ii)
376C
377 ix1 = irect(1,l)
378 ix2 = irect(2,l)
379 ix3 = irect(3,l)
380 ix4 = irect(4,l)
381C
382 IF (i > 0) THEN
383 s = crst(1,ii)
384 t = crst(2,ii)
385 l = irtl(ii)
386C
387 ix1 = irect(1,l)
388 ix2 = irect(2,l)
389 ix3 = irect(3,l)
390 ix4 = irect(4,l)
391C
392 nir= 4
393 sp = one + s
394 sm = one - s
395 tp = fourth*(one + t)
396 tm = fourth*(one - t)
397C
398 h(1)=tm*sm
399 h(2)=tm*sp
400 h(3)=tp*sp
401 h(4)=tp*sm
402C
403 IF (ix3 == ix4) THEN
404 nir = 3
405 h(3) = h(3) + h(4)
406 h(4) = zero
407 ENDIF
408C------------------------------------------------
409C rep local facette main
410C------------------------------------------------
411 x1 = x(1,ix1)
412 y1 = x(2,ix1)
413 z1 = x(3,ix1)
414 x2 = x(1,ix2)
415 y2 = x(2,ix2)
416 z2 = x(3,ix2)
417 x3 = x(1,ix3)
418 y3 = x(2,ix3)
419 z3 = x(3,ix3)
420 x4 = x(1,ix4)
421 y4 = x(2,ix4)
422 z4 = x(3,ix4)
423 xs = x(1,i)
424 ys = x(2,i)
425 zs = x(3,i)
426
427C---------------------
428 CALL i2rep(x1 ,x2 ,x3 ,x4 ,
429 . y1 ,y2 ,y3 ,y4 ,
430 . z1 ,z2 ,z3 ,z4 ,
431 . e1x ,e1y ,e1z ,
432 . e2x ,e2y ,e2z ,
433 . e3x ,e3y ,e3z ,nir )
434C------------------------------------------------
435 IF (nir == 4) THEN
436 fac_triang = one
437C
438 xm = x1*h(1) + x2*h(2) + x3*h(3) + x4*h(4)
439 ym = y1*h(1) + y2*h(2) + y3*h(3) + y4*h(4)
440 zm = z1*h(1) + z2*h(2) + z3*h(3) + z4*h(4)
441 x0 = (x1 + x2 + x3 + x4)/nir
442 y0 = (y1 + y2 + y3 + y4)/nir
443 z0 = (z1 + z2 + z3 + z4)/nir
444
445 xm = xm - x0
446 ym = ym - y0
447 zm = zm - z0
448 xs = xs - x0
449 ys = ys - y0
450 zs = zs - z0
451 xsm = xs - xm
452 ysm = ys - ym
453 zsm = zs - zm
454C
455 ELSE
456 fac_triang = zero
457C
458 x0 = (x1 + x2 + x3)/nir
459 y0 = (y1 + y2 + y3)/nir
460 z0 = (z1 + z2 + z3)/nir
461
462 xm = x1*h(1) + x2*h(2) + x3*h(3)
463 ym = y1*h(1) + y2*h(2) + y3*h(3)
464 zm = z1*h(1) + z2*h(2) + z3*h(3)
465
466 xm = xm - x0
467 ym = ym - y0
468 zm = zm - z0
469 xs = xs - x0
470 ys = ys - y0
471 zs = zs - z0
472 xsm = xs - xm
473 ysm = ys - ym
474 zsm = zs - zm
475 ENDIF
476C
477 x1 = x1 - x0
478 y1 = y1 - y0
479 z1 = z1 - z0
480 x2 = x2 - x0
481 y2 = y2 - y0
482 z2 = z2 - z0
483 x3 = x3 - x0
484 y3 = y3 - y0
485 z3 = z3 - z0
486 x4 = x4 - x0
487 y4 = y4 - y0
488 z4 = z4 - z0
489C
490c global -> local
491c
492 rs(1) = xs*e1x + ys*e1y + zs*e1z
493 rs(2) = xs*e2x + ys*e2y + zs*e2z
494 rs(3) = xs*e3x + ys*e3y + zs*e3z
495 rm(1) = xm*e1x + ym*e1y + zm*e1z
496 rm(2) = xm*e2x + ym*e2y + zm*e2z
497 rm(3) = xm*e3x + ym*e3y + zm*e3z
498c
499 rx(1) = e1x*x1 + e1y*y1 + e1z*z1
500 ry(1) = e2x*x1 + e2y*y1 + e2z*z1
501 rz(1) = e3x*x1 + e3y*y1 + e3z*z1
502 rx(2) = e1x*x2 + e1y*y2 + e1z*z2
503 ry(2) = e2x*x2 + e2y*y2 + e2z*z2
504 rz(2) = e3x*x2 + e3y*y2 + e3z*z2
505 rx(3) = e1x*x3 + e1y*y3 + e1z*z3
506 ry(3) = e2x*x3 + e2y*y3 + e2z*z3
507 rz(3) = e3x*x3 + e3y*y3 + e3z*z3
508 rx(4) = e1x*x4 + e1y*y4 + e1z*z4
509 ry(4) = e2x*x4 + e2y*y4 + e2z*z4
510 rz(4) = e3x*x4 + e3y*y4 + e3z*z4
511C
512 IF (nir==3) THEN
513 rx(4)=zero
514 ry(4)=zero
515 rz(4)=zero
516 END IF
517C
518C---------
519 CALL i2pen_rot(skew,tt ,bid ,stbrk,
520 . rs ,rm ,bid ,bid ,bid ,
521 . rx ,ry ,rz ,bid3 ,bid3 ,
522 . bid3 ,bid3)
523C
524C------------------------------------------------
525 stf = stfn(ii)*(visc + sqrt(visc**2 + (one+stbrk)))**2
526 stifm=zero
527
528C------------------------------------------------
529C
530C-- Secnd node of solids
531C
532 str = zero
533c update main forces (moment balance)
534 CALL i2loceq( nir ,rs ,rx ,ry ,rz ,
535 . bid4(1:4,1) ,bid4(1:4,2) ,bid4(1:4,3) ,h(1) ,stifm)
536C
537C----------------------------------------------------
538C
539 stifn(ix1) = stifn(ix1)+abs(stf*h(1))+stifm*stf
540 stifn(ix2) = stifn(ix2)+abs(stf*h(2))+stifm*stf
541 stifn(ix3) = stifn(ix3)+abs(stf*h(3))+stifm*stf
542 stifn(ix4) = stifn(ix4)+abs(stf*h(4))+stifm*stf*fac_triang
543C
544 END IF
545C
546 ENDDO
547C
548C-----------
549 RETURN
550 END
my_real
#define my_real
Definition cppsort.cpp:32
i2_dtn_1
subroutine i2_dtn_1(x, irect, nsv, irtl, ipari, stifn, stifr, ms, in, ilev)
Definition i2_dtn.F:173
i2_dtn_25
subroutine i2_dtn_25(x, irect, crst, nsv, irtl, ipari, stifn, stfn, visc)
Definition i2_dtn.F:342
i2_dtn
subroutine i2_dtn(x, intbuf_tab, ipari, stifn, ms, in, n, ilev)
Definition i2_dtn.F:34
i2_dtn_0
subroutine i2_dtn_0(irect, crst, csts_bis, nsv, irtl, ipari, stifn, ms)
Definition i2_dtn.F:83
i2loceq
subroutine i2loceq(nir, rs, rx, ry, rz, fmx, fmy, fmz, h, stifm)
Definition i2loceq.F:40
i2pen_rot
subroutine i2pen_rot(skew, tt, dt1, stif, rs, rm, v1, v2, v3, rx, ry, rz, va, vb, vc, vd)
Definition i2pen_rot.F:34
i2rep
subroutine i2rep(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, nir)
Definition i2rep.F:48
max
#define max(a, b)
Definition macros.h:21