OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11dst3.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!|| i11dst3 ../starter/source/interfaces/inter3d1/i11dst3.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||====================================================================
28 SUBROUTINE i11dst3(JLT ,GAP ,CAND_S,CAND_M,IRECTS ,
29 . IRECTM ,NX,NY,NZ,
30 . N1,N2,M1,M2,JLT_NEW,
31 . X ,IGAP,GAP_S,GAP_M, GAPV2,
32 . GAP_S_L,GAP_M_L,DRAD,DGAPLOAD)
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 JLT,JLT_NEW,IGAP
45 INTEGER IRECTS(2,*), IRECTM(2,*),CAND_S(*),CAND_M(*),
46 . N1(*),N2(*),M1(*),M2(*)
47 my_real , INTENT(IN) :: DGAPLOAD
48 my_real
49 . gap,drad,
50 . nx(*),ny(*),nz(*),x(3,*),gap_s(*),gap_m(*), gapv2(*),
51 . gap_s_l(*),gap_m_l(*)
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I
56 my_real
57 . XS12,YS12,ZS12,XM12,YM12,ZM12,XA,XB,
58 . XS2,XM2,XSM,XS2M2,YS2,YM2,YSM,YS2M2,ZS2,ZM2,ZSM,ZS2M2,
59 . xx,yy,zz,als,alm,det,h1s,h2s,h1m,h2m,
60 . gap2,drad2,
61 . pene2(mvsiz)
62C-----------------------------------------------
63 gap2=(gap+dgapload)*(gap+dgapload)
64 drad2=drad*drad
65C
66 IF(igap==0)THEN
67 DO i=1,jlt
68 gapv2(i)=gap2
69 ENDDO
70 ELSE
71 DO i=1,jlt
72 gapv2(i)=gap_s(cand_s(i))+gap_m(cand_m(i))
73 IF(igap == 3)
74 . gapv2(i)=min(gap_s_l(cand_s(i))+gap_m_l(cand_m(i)),gapv2(i))+dgapload
75 gapv2(i)=max(gapv2(i)*gapv2(i),gap2)
76 ENDDO
77 ENDIF
78C--------------------------------------------------------
79C
80C--------------------------------------------------------
81C F = [A*X1+(1-A)*X2-B*X3-(1-B)*X4]^2 + [..Y..]^2 + [..Z..]^2
82C DF/DA = 0 = (X1-X2)(A(X1-X2)+X2-X4 +B(X4-X3))+...
83C DF/DA = 0 = A(X1-X2)^2 +X2-X4 + B(X1-X2)(X4-X3))+...
84C DF/DA = 0 = A[(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
85C + B[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
86C + (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
87C DF/DB = 0 = (X4-X3)(A(X1-X2)+X2-X4 +B(X4-X3))+...
88C DF/DB = 0 = B[(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
89C + A[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
90C + (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
91C XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
92C XM2 = [(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
93C XSM = [(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
94C XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
95C XB = (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
96C A XS2 + B XSM + XA = 0
97C A XSM + B XM2 + XB = 0
98C
99C A = -(XA + B XSM)/XS2
100C -(XA + B XSM)*XSM + B XM2*XS2 + XB*XS2 = 0
101C -B XSM*XSM + B XM2*XS2 + XB*XS2-XA*XSM = 0
102C B*(XM2*XS2 - XSM*XSM) = -XB*XS2+XA*XSM
103C B = (XA*XSM-XB*XS2) / (XM2*XS2 - XSM*XSM)
104C A = (XB*XSM-XA*XM2) / (XM2*XS2 - XSM*XSM)
105 DO i=1,jlt
106 n1(i)=irects(1,cand_s(i))
107 n2(i)=irects(2,cand_s(i))
108 m1(i)=irectm(1,cand_m(i))
109 m2(i)=irectm(2,cand_m(i))
110 xs12 = x(1,n2(i))-x(1,n1(i))
111 ys12 = x(2,n2(i))-x(2,n1(i))
112 zs12 = x(3,n2(i))-x(3,n1(i))
113 xs2 = xs12*xs12 + ys12*ys12 + zs12*zs12
114 xm12 = x(1,m2(i))-x(1,m1(i))
115 ym12 = x(2,m2(i))-x(2,m1(i))
116 zm12 = x(3,m2(i))-x(3,m1(i))
117 xm2 = xm12*xm12 + ym12*ym12 + zm12*zm12
118 xsm = - (xs12*xm12 + ys12*ym12 + zs12*zm12)
119 xs2m2 = x(1,m2(i))-x(1,n2(i))
120 ys2m2 = x(2,m2(i))-x(2,n2(i))
121 zs2m2 = x(3,m2(i))-x(3,n2(i))
122 xa = xs12*xs2m2 + ys12*ys2m2 + zs12*zs2m2
123 xb = -xm12*xs2m2 - ym12*ys2m2 - zm12*zs2m2
124 det = xm2*xs2 - xsm*xsm
125 det = max(em20,det)
126C
127 h1m = (xa*xsm-xb*xs2) / det
128C
129 xs2 = max(xs2,em20)
130 xm2 = max(xm2,em20)
131 h1m=min(one,max(zero,h1m))
132 h1s = -(xa + h1m*xsm) / xs2
133 h1s=min(one,max(zero,h1s))
134 h1m = -(xb + h1s*xsm) / xm2
135 h1m=min(one,max(zero,h1m))
136C
137 h2s = one - h1s
138 h2m = one - h1m
139C !!!!!!!!!!!!!!!!!!!!!!!
140C PENE = GAP^2 - DIST^2 UTILISE POUR TESTER SI NON NUL
141C!!!!!!!!!!!!!!!!!!!!!!!!
142 nx(i) = h1s*x(1,n1(i)) + h2s*x(1,n2(i))
143 . - h1m*x(1,m1(i)) - h2m*x(1,m2(i))
144 ny(i) = h1s*x(2,n1(i)) + h2s*x(2,n2(i))
145 . - h1m*x(2,m1(i)) - h2m*x(2,m2(i))
146 nz(i) = h1s*x(3,n1(i)) + h2s*x(3,n2(i))
147 . - h1m*x(3,m1(i)) - h2m*x(3,m2(i))
148 pene2(i) = max(gapv2(i),drad2) - nx(i)*nx(i) - ny(i)*ny(i) - nz(i)*nz(i)
149 pene2(i) = max(zero,pene2(i))
150C
151 ENDDO
152 DO i=1,jlt
153 IF(pene2(i)/=zero)THEN
154 jlt_new = jlt_new + 1
155 cand_s(jlt_new) = cand_s(i)
156 cand_m(jlt_new) = cand_m(i)
157 n1(jlt_new) = n1(i)
158 n2(jlt_new) = n2(i)
159 m1(jlt_new) = m1(i)
160 m2(jlt_new) = m2(i)
161 nx(jlt_new) = nx(i)
162 ny(jlt_new) = ny(i)
163 nz(jlt_new) = nz(i)
164 gapv2(jlt_new) = gapv2(i)
165 ENDIF
166 ENDDO
167C
168 RETURN
169 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
i11dst3
subroutine i11dst3(jlt, gap, cand_s, cand_m, irects, irectm, nx, ny, nz, n1, n2, m1, m2, jlt_new, x, igap, gap_s, gap_m, gapv2, gap_s_l, gap_m_l, drad, dgapload)
Definition i11dst3.F:33