OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11dstk3.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!|| i11dstk3 ../engine/source/interfaces/int11/i11dstk3.f
25!||--- called by ------------------------------------------------------
26!|| i11fku3 ../engine/source/interfaces/int11/i11ke3.F
27!|| i11ke3 ../engine/source/interfaces/int11/i11ke3.F
28!|| imp_i11mainf ../engine/source/interfaces/int11/i11ke3.F
29!||====================================================================
30 SUBROUTINE i11dstk3(
31 1 JLT ,CAND_S,CAND_M,H1S ,H2S ,
32 2 H1M ,H2M ,NX ,NY ,NZ ,
33 3 STIF ,N1 ,N2 ,M1 ,M2 ,
34 4 XXS1 ,XXS2 ,XYS1 ,XYS2 ,
35 5 XZS1 ,XZS2 ,XXM1 ,XXM2 ,XYM1 ,
36 6 XYM2 ,XZM1 ,XZM2 ,VXS1 ,VXS2 ,
37 7 VYS1 ,VYS2 ,VZS1 ,VZS2 ,VXM1 ,
38 8 VXM2 ,VYM1 ,VYM2 ,VZM1 ,VZM2 ,
39 9 MS1 ,MS2 ,MM1 ,MM2 ,GAPV )
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER JLT,IGAP
52 INTEGER CAND_S(*),CAND_M(*),
53 . N1(*),N2(*),M1(*),M2(*)
54 my_real
55 . H1S(*),H2S(*),H1M(*),H2M(*),NX(*),NY(*),NZ(*),STIF(*),
56 . XXS1(*) ,XXS2(*) ,XYS1(*) ,XYS2(*) ,
57 . XZS1(*) ,XZS2(*) ,XXM1(*) ,XXM2(*) ,XYM1(*),
58 . XYM2(*) ,XZM1(*) ,XZM2(*) ,VXS1(*) ,VXS2(*),
59 . VYS1(*) ,VYS2(*) ,VZS1(*) ,VZS2(*) ,VXM1(*),
60 . vxm2(*) ,vym1(*) ,vym2(*) ,vzm1(*) ,vzm2(*),
61 . ms1(*) ,ms2(*) ,mm1(*) ,mm2(*), gapv(*)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER I
66 my_real
67 . PENE2(MVSIZ),
68 . XS12,YS12,ZS12,XM12,YM12,ZM12,XA,XB,
69 . XS2,XM2,XSM,XS2M2,YS2,YM2,YSM,YS2M2,ZS2,ZM2,ZSM,ZS2M2,
70 . XX,YY,ZZ,ALS,ALM,DET,
71 . GAP2
72C-----------------------------------------------
73C--------------------------------------------------------
74C F = [A*X1+(1-A)*X2-B*X3-(1-B)*X4]^2 + [..Y..]^2 + [..Z..]^2
75C DF/DA = 0 = (X1-X2)(A(X1-X2)+X2-X4 +B(X4-X3))+...
76C DF/DA = 0 = A(X1-X2)^2 +X2-X4 + B(X1-X2)(X4-X3))+...
77C DF/DA = 0 = A[(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
78C + B[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
79C + (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
80C DF/DB = 0 = (X4-X3)(A(X1-X2)+X2-X4 +B(X4-X3))+...
81C DF/DB = 0 = B[(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
82C + A[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
83C + (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
84C XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
85C XM2 = [(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
86C XSM = [(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
87C XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
88C XB = (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
89C A XS2 + B XSM + XA = 0
90C A XSM + B XM2 + XB = 0
91C
92C A = -(XA + B XSM)/XS2
93C -(XA + B XSM)*XSM + B XM2*XS2 + XB*XS2 = 0
94C -B XSM*XSM + B XM2*XS2 + XB*XS2-XA*XSM = 0
95C B*(XM2*XS2 - XSM*XSM) = -XB*XS2+XA*XSM
96C B = (XA*XSM-XB*XS2) / (XM2*XS2 - XSM*XSM)
97C A = (XB*XSM-XA*XM2) / (XM2*XS2 - XSM*XSM)
98C
99C IF B<0 => B=0
100C
101C XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
102C XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
103C A = - XA /XS2
104C B = 0
105C
106C ELSEIF B>1 => B=1
107C
108C B = 1
109C XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
110C XSM = [(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
111C XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
112C A = -(XA + XSM)/XS2
113C
114C IF A<0 => A=0
115C
116C
117C ELSEIF A>1 => A=1
118C
119C
120 DO i=1,jlt
121 xs12 = xxs2(i)-xxs1(i)
122 ys12 = xys2(i)-xys1(i)
123 zs12 = xzs2(i)-xzs1(i)
124 xs2 = xs12*xs12 + ys12*ys12 + zs12*zs12
125 xm12 = xxm2(i)-xxm1(i)
126 ym12 = xym2(i)-xym1(i)
127 zm12 = xzm2(i)-xzm1(i)
128 xm2 = xm12*xm12 + ym12*ym12 + zm12*zm12
129 xsm = - (xs12*xm12 + ys12*ym12 + zs12*zm12)
130 xs2m2 = xxm2(i)-xxs2(i)
131 ys2m2 = xym2(i)-xys2(i)
132 zs2m2 = xzm2(i)-xzs2(i)
133C
134 xa = xs12*xs2m2 + ys12*ys2m2 + zs12*zs2m2
135 xb = -xm12*xs2m2 - ym12*ys2m2 - zm12*zs2m2
136 det = xm2*xs2 - xsm*xsm
137 det = max(em20,det)
138C
139 h1s(i) = (xb*xsm-xa*xm2) / det
140 h1m(i) = (xa*xsm-xb*xs2) / det
141C
142 xs2 = max(xs2,em20)
143 xm2 = max(xm2,em20)
144 IF(h1m(i)<zero)THEN
145 h1m(i) = zero
146 h1s(i) = -xa / xs2
147 ELSEIF(h1m(i)>one)THEN
148 h1m(i) = one
149 h1s(i) = -(xa + xsm) / xs2
150 ENDIF
151C
152 IF(h1s(i)<zero)THEN
153 h1s(i) = zero
154 h1m(i) = -xb / xm2
155 ELSEIF(h1s(i)>one)THEN
156 h1s(i) = one
157 h1m(i) = -(xb + xsm) / xm2
158 ENDIF
159C
160 h1m(i) = min(one,h1m(i))
161 h1m(i) = max(zero,h1m(i))
162C
163 h2s(i) = one -h1s(i)
164 h2m(i) = one -h1m(i)
165C !!!!!!!!!!!!!!!!!!!!!!!
166C PENE = GAP^2 - DIST^2 UTILISE POUR TESTER SI NON NUL
167C!!!!!!!!!!!!!!!!!!!!!!!!
168 nx(i) = h1s(i)*xxs1(i) + h2s(i)*xxs2(i)
169 . - h1m(i)*xxm1(i) - h2m(i)*xxm2(i)
170 ny(i) = h1s(i)*xys1(i) + h2s(i)*xys2(i)
171 . - h1m(i)*xym1(i) - h2m(i)*xym2(i)
172 nz(i) = h1s(i)*xzs1(i) + h2s(i)*xzs2(i)
173 . - h1m(i)*xzm1(i) - h2m(i)*xzm2(i)
174C
175 ENDDO
176C
177 RETURN
178 END
179!||====================================================================
180!|| i11dstr3 ../engine/source/interfaces/int11/i11dstk3.F
181!||--- called by ------------------------------------------------------
182!|| imp_i11mainf ../engine/source/interfaces/int11/i11ke3.F
183!||====================================================================
184 SUBROUTINE i11dstr3(
185 1 JLT ,CAND_S,CAND_M,STIF ,GAPV ,
186 2 NX ,NY ,NZ ,JLT_NEW)
187C-----------------------------------------------
188C I m p l i c i t T y p e s
189C-----------------------------------------------
190#include "implicit_f.inc"
191C-----------------------------------------------
192C G l o b a l P a r a m e t e r s
193C-----------------------------------------------
194#include "mvsiz_p.inc"
195C-----------------------------------------------
196C D u m m y A r g u m e n t s
197C-----------------------------------------------
198 INTEGER JLT,JLT_NEW
199 INTEGER CAND_S(*),CAND_M(*)
200 my_real
201 . NX(*),NY(*),NZ(*),STIF(*), GAPV(*)
202C-----------------------------------------------
203C L o c a l V a r i a b l e s
204C-----------------------------------------------
205 INTEGER I
206 my_real
207 . PENE2(MVSIZ),GAP2,FAC
208C--------------------------------------------------------
209 fac = zep97*zep97
210 DO i=1,jlt
211 gap2 = fac*gapv(i)*gapv(i)
212 pene2(i) = gap2 - nx(i)*nx(i) - ny(i)*ny(i) - nz(i)*nz(i)
213 pene2(i) = max(zero,pene2(i))
214 ENDDO
215 DO i=1,jlt
216 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
217 jlt_new = jlt_new + 1
218 cand_s(jlt_new) = cand_s(i)
219 cand_m(jlt_new) = cand_m(i)
220 ENDIF
221 ENDDO
222C
223 RETURN
224 END
i11dstr3
subroutine i11dstr3(jlt, cand_s, cand_m, stif, gapv, nx, ny, nz, jlt_new)
Definition i11dstk3.F:187
i11dstk3
subroutine i11dstk3(jlt, cand_s, cand_m, h1s, h2s, h1m, h2m, nx, ny, nz, stif, n1, n2, m1, m2, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, vxs1, vxs2, vys1, vys2, vzs1, vzs2, vxm1, vxm2, vym1, vym2, vzm1, vzm2, ms1, ms2, mm1, mm2, gapv)
Definition i11dstk3.F:40
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21