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