OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7dstk3.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!|| i7dstk3 ../engine/source/interfaces/int07/i7dstk3.F
25!||--- called by ------------------------------------------------------
26!|| i10fku3 ../engine/source/interfaces/int10/i10ke3.F
27!|| i10ke3 ../engine/source/interfaces/int10/i10ke3.F
28!|| i7fku3 ../engine/source/interfaces/int07/i7ke3.F
29!|| i7ke3 ../engine/source/interfaces/int07/i7ke3.F
30!|| imp_i10mainf ../engine/source/interfaces/int10/i10ke3.F
31!|| imp_i7mainf ../engine/source/interfaces/int07/i7ke3.F
32!||====================================================================
33 SUBROUTINE i7dstk3(
34 1 JLT ,CAND_N ,CAND_E ,
35 2 X1 ,X2 ,X3 ,X4 ,Y1 ,
36 3 Y2 ,Y3 ,Y4 ,Z1 ,Z2 ,
37 4 Z3 ,Z4 ,XI ,YI ,ZI ,
38 5 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
39 6 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
40 7 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
41 8 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
42 9 P1 ,P2 ,P3 ,P4 ,IX1 ,
43 A IX2 ,IX3 ,IX4 ,NSVG ,STIF ,
44 B I3N ,GAPV ,INACTI ,CAND_P ,INDEX )
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER JLT, JLT_NEW,INACTI, CAND_N(*),CAND_E(*)
57 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
58 . NSVG(MVSIZ),INDEX(MVSIZ),I3N
59 my_real
60 . NX1(MVSIZ), NX2(MVSIZ), NX3(MVSIZ), NX4(MVSIZ),
61 . NY1(MVSIZ), NY2(MVSIZ), NY3(MVSIZ), NY4(MVSIZ),
62 . NZ1(MVSIZ), NZ2(MVSIZ), NZ3(MVSIZ), NZ4(MVSIZ),
63 . LB1(MVSIZ), LB2(MVSIZ), LB3(MVSIZ), LB4(MVSIZ),
64 . LC1(MVSIZ), LC2(MVSIZ), LC3(MVSIZ), LC4(MVSIZ),
65 . KB1(MVSIZ), KB2(MVSIZ), KB3(MVSIZ), KB4(MVSIZ),
66 . KC1(MVSIZ), KC2(MVSIZ), KC3(MVSIZ), KC4(MVSIZ),
67 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
68 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
69 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
70 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
71 . p1(mvsiz), p2(mvsiz), p3(mvsiz), p4(mvsiz),
72 . gapv(mvsiz), cand_p(*)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I, IG, J
77 my_real
78 . X0(MVSIZ), Y0(MVSIZ), Z0(MVSIZ),
79 . AL1(MVSIZ), AL2(MVSIZ), AL3(MVSIZ), AL4(MVSIZ),
80 . X01(MVSIZ), X02(MVSIZ), X03(MVSIZ), X04(MVSIZ),
81 . Y01(MVSIZ), Y02(MVSIZ), Y03(MVSIZ), Y04(MVSIZ),
82 . Z01(MVSIZ), Z02(MVSIZ), Z03(MVSIZ), Z04(MVSIZ),
83 . XI1(MVSIZ), XI2(MVSIZ), XI3(MVSIZ), XI4(MVSIZ),
84 . YI1(MVSIZ), YI2(MVSIZ), YI3(MVSIZ), YI4(MVSIZ),
85 . ZI1(MVSIZ), ZI2(MVSIZ), ZI3(MVSIZ), ZI4(MVSIZ),
86 . HLB1(MVSIZ), HLC1(MVSIZ), HLB2(MVSIZ),HLC2(MVSIZ),
87 . hlb3(mvsiz), hlc3(mvsiz), hlb4(mvsiz),hlc4(mvsiz)
88 my_real
89 . s2,d1,d2,d3,d4,
90 . x12,x23,x34,x41,xi0,sx1,sx2,sx3,sx4,sx0,
91 . y12,y23,y34,y41,yi0,sy1,sy2,sy3,sy4,sy0,
92 . z12,z23,z34,z41,zi0,sz1,sz2,sz3,sz4,sz0,
93 . ds2,t1,t2,t3,la, hla, aaa,
94 . xi0v(mvsiz), yi0v(mvsiz), zi0v(mvsiz)
95C-----------------------------------------------
96C--------------------------------------------------------
97C CAS DES PAQUETS MIXTES
98C--------------------------------------------------------
99 i3n=2
100 DO i=1,jlt
101 IF(ix3(i)/=ix4(i))THEN
102 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
103 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
104 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
105 ELSE
106 x0(i) = x3(i)
107 y0(i) = y3(i)
108 z0(i) = z3(i)
109 ENDIF
110 ENDDO
111C--------------------------------------------------------
112C CAS DES PAQUETS MIXTES OU QUADRANGLE
113C--------------------------------------------------------
114C
115 DO i=1,jlt
116C
117 x01(i) = x1(i) - x0(i)
118 y01(i) = y1(i) - y0(i)
119 z01(i) = z1(i) - z0(i)
120C
121 x02(i) = x2(i) - x0(i)
122 y02(i) = y2(i) - y0(i)
123 z02(i) = z2(i) - z0(i)
124C
125 x03(i) = x3(i) - x0(i)
126 y03(i) = y3(i) - y0(i)
127 z03(i) = z3(i) - z0(i)
128C
129 x04(i) = x4(i) - x0(i)
130 y04(i) = y4(i) - y0(i)
131 z04(i) = z4(i) - z0(i)
132C
133 xi0v(i) = x0(i) - xi(i)
134 yi0v(i) = y0(i) - yi(i)
135 zi0v(i) = z0(i) - zi(i)
136C
137 xi1(i) = x1(i) - xi(i)
138 yi1(i) = y1(i) - yi(i)
139 zi1(i) = z1(i) - zi(i)
140C
141 xi2(i) = x2(i) - xi(i)
142 yi2(i) = y2(i) - yi(i)
143 zi2(i) = z2(i) - zi(i)
144C
145 xi3(i) = x3(i) - xi(i)
146 yi3(i) = y3(i) - yi(i)
147 zi3(i) = z3(i) - zi(i)
148C
149 xi4(i) = x4(i) - xi(i)
150 yi4(i) = y4(i) - yi(i)
151 zi4(i) = z4(i) - zi(i)
152C
153 sx1 = yi0v(i)*zi1(i) - zi0v(i)*yi1(i)
154 sy1 = zi0v(i)*xi1(i) - xi0v(i)*zi1(i)
155 sz1 = xi0v(i)*yi1(i) - yi0v(i)*xi1(i)
156 sx2 = yi0v(i)*zi2(i) - zi0v(i)*yi2(i)
157 sy2 = zi0v(i)*xi2(i) - xi0v(i)*zi2(i)
158 sz2 = xi0v(i)*yi2(i) - yi0v(i)*xi2(i)
159C
160 sx0 = y01(i)*z02(i) - z01(i)*y02(i)
161 sy0 = z01(i)*x02(i) - x01(i)*z02(i)
162 sz0 = x01(i)*y02(i) - y01(i)*x02(i)
163 s2 = 1./max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
164C
165 lb1(i) = -(sx0*sx2 + sy0*sy2 + sz0*sz2) * s2
166 lc1(i) = (sx0*sx1 + sy0*sy1 + sz0*sz1) * s2
167C
168 sx3 = yi0v(i)*zi3(i) - zi0v(i)*yi3(i)
169 sy3 = zi0v(i)*xi3(i) - xi0v(i)*zi3(i)
170 sz3 = xi0v(i)*yi3(i) - yi0v(i)*xi3(i)
171C
172 sx0 = y02(i)*z03(i) - z02(i)*y03(i)
173 sy0 = z02(i)*x03(i) - x02(i)*z03(i)
174 sz0 = x02(i)*y03(i) - y02(i)*x03(i)
175 s2 = 1./max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
176C
177 lb2(i) = -(sx0*sx3 + sy0*sy3 + sz0*sz3) * s2
178 lc2(i) = (sx0*sx2 + sy0*sy2 + sz0*sz2) * s2
179C
180 sx4 = yi0v(i)*zi4(i) - zi0v(i)*yi4(i)
181 sy4 = zi0v(i)*xi4(i) - xi0v(i)*zi4(i)
182 sz4 = xi0v(i)*yi4(i) - yi0v(i)*xi4(i)
183C
184 sx0 = y03(i)*z04(i) - z03(i)*y04(i)
185 sy0 = z03(i)*x04(i) - x03(i)*z04(i)
186 sz0 = x03(i)*y04(i) - y03(i)*x04(i)
187 s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
188C
189 lb3(i) = -(sx0*sx4 + sy0*sy4 + sz0*sz4) * s2
190 lc3(i) = (sx0*sx3 + sy0*sy3 + sz0*sz3) * s2
191C
192 sx0 = y04(i)*z01(i) - z04(i)*y01(i)
193 sy0 = z04(i)*x01(i) - x04(i)*z01(i)
194 sz0 = x04(i)*y01(i) - y04(i)*x01(i)
195 s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
196C
197 lb4(i) = -(sx0*sx1 + sy0*sy1 + sz0*sz1) * s2
198 lc4(i) = (sx0*sx4 + sy0*sy4 + sz0*sz4) * s2
199C
200 ENDDO
201 DO i=1,jlt
202 aaa = one/max(em30,x01(i)*x01(i)+y01(i)*y01(i)+z01(i)*z01(i))
203 hlc1(i)= lc1(i)*abs(lc1(i))*aaa
204 hlb4(i)= lb4(i)*abs(lb4(i))*aaa
205 al1(i) = -(xi0v(i)*x01(i)+yi0v(i)*y01(i)+zi0v(i)*z01(i))*aaa
206 al1(i) = max(zero,min(one,al1(i)))
207 aaa = one/max(em30,x02(i)*x02(i)+y02(i)*y02(i)+z02(i)*z02(i))
208 hlc2(i)= lc2(i)*abs(lc2(i))*aaa
209 hlb1(i)= lb1(i)*abs(lb1(i))*aaa
210 al2(i) = -(xi0v(i)*x02(i)+yi0v(i)*y02(i)+zi0v(i)*z02(i))*aaa
211 al2(i) = max(zero,min(one,al2(i)))
212 aaa = one/max(em30,x03(i)*x03(i)+y03(i)*y03(i)+z03(i)*z03(i))
213 hlc3(i)= lc3(i)*abs(lc3(i))*aaa
214 hlb2(i)= lb2(i)*abs(lb2(i))*aaa
215 al3(i) = -(xi0v(i)*x03(i)+yi0v(i)*y03(i)+zi0v(i)*z03(i))*aaa
216 al3(i) = max(zero,min(one,al3(i)))
217 aaa = one/max(em30,x04(i)*x04(i)+y04(i)*y04(i)+z04(i)*z04(i))
218 hlc4(i)= lc4(i)*abs(lc4(i))*aaa
219 hlb3(i)= lb3(i)*abs(lb3(i))*aaa
220 al4(i) = -(xi0v(i)*x04(i)+yi0v(i)*y04(i)+zi0v(i)*z04(i))*aaa
221 al4(i) = max(zero,min(one,al4(i)))
222 ENDDO
223C
224 DO i=1,jlt
225 x12 = x2(i) - x1(i)
226 y12 = y2(i) - y1(i)
227 z12 = z2(i) - z1(i)
228 la = one - lb1(i) - lc1(i)
229 aaa = one / max(em20,x12*x12+y12*y12+z12*z12)
230 hla= la*abs(la) * aaa
231 IF(la<zero.AND.
232 + hla<=hlb1(i).AND.hla<=hlc1(i))THEN
233 lb1(i) = (xi2(i)*x12+yi2(i)*y12+zi2(i)*z12) * aaa
234 lb1(i) = max(zero,min(one,lb1(i)))
235 lc1(i) = one - lb1(i)
236 ELSEIF(lb1(i)<zero.AND.
237 + hlb1(i)<=hlc1(i).AND.hlb1(i)<=hla)THEN
238 lb1(i) = zero
239 lc1(i) = al2(i)
240 ELSEIF(lc1(i)<zero.AND.
241 + hlc1(i)<=hla.AND.hlc1(i)<=hlb1(i))THEN
242 lc1(i) = zero
243 lb1(i) = al1(i)
244 ENDIF
245 ENDDO
246C
247 DO i=1,jlt
248 x23 = x3(i) - x2(i)
249 y23 = y3(i) - y2(i)
250 z23 = z3(i) - z2(i)
251 la = one - lb2(i) - lc2(i)
252 aaa = one / max(em20,x23*x23+y23*y23+z23*z23)
253 hla= la*abs(la) * aaa
254 IF(la<zero.AND.
255 + hla<=hlb2(i).AND.hla<=hlc2(i))THEN
256 lb2(i) = (xi3(i)*x23+yi3(i)*y23+zi3(i)*z23)*aaa
257 lb2(i) = max(zero,min(one,lb2(i)))
258 lc2(i) = one - lb2(i)
259 ELSEIF(lb2(i)<zero.AND.
260 + hlb2(i)<=hlc2(i).AND.hlb2(i)<=hla)THEN
261 lb2(i) = zero
262 lc2(i) = al3(i)
263 ELSEIF(lc2(i)<zero.AND.
264 + hlc2(i)<=hla.AND.hlc2(i)<=hlb2(i))THEN
265 lc2(i) = zero
266 lb2(i) = al2(i)
267 ENDIF
268 ENDDO
269C
270 DO i=1,jlt
271 x34 = x4(i) - x3(i)
272 y34 = y4(i) - y3(i)
273 z34 = z4(i) - z3(i)
274 la = one - lb3(i) - lc3(i)
275 aaa = one / max(em20,x34*x34+y34*y34+z34*z34)
276 hla= la*abs(la) * aaa
277 IF(la<zero.AND.
278 + hla<=hlb3(i).AND.hla<=hlc3(i))THEN
279 lb3(i) = (xi4(i)*x34+yi4(i)*y34+zi4(i)*z34)*aaa
280 lb3(i) = max(zero,min(one,lb3(i)))
281 lc3(i) = one - lb3(i)
282 ELSEIF(lb3(i)<zero.AND.
283 + hlb3(i)<=hlc3(i).AND.hlb3(i)<=hla)THEN
284 lb3(i) = zero
285 lc3(i) = al4(i)
286 ELSEIF(lc3(i)<zero.AND.
287 + hlc3(i)<=hla.AND.hlc3(i)<=hlb3(i))THEN
288 lc3(i) = zero
289 lb3(i) = al3(i)
290 ENDIF
291 ENDDO
292C
293 DO i=1,jlt
294 x41 = x1(i) - x4(i)
295 y41 = y1(i) - y4(i)
296 z41 = z1(i) - z4(i)
297 la = one - lb4(i) - lc4(i)
298 aaa = one / max(em20,x41*x41+y41*y41+z41*z41)
299 hla= la*abs(la) * aaa
300 IF(la<zero.AND.
301 + hla<=hlb4(i).AND.hla<=hlc4(i))THEN
302 lb4(i) = (xi1(i)*x41+yi1(i)*y41+zi1(i)*z41)*aaa
303 lb4(i) = max(zero,min(one,lb4(i)))
304 lc4(i) = one - lb4(i)
305 ELSEIF(lb4(i)<zero.AND.
306 + hlb4(i)<=hlc4(i).AND.hlb4(i)<=hla)THEN
307 lb4(i) = zero
308 lc4(i) = al1(i)
309 ELSEIF(lc4(i)<zero.AND.
310 + hlc4(i)<=hla.AND.hlc4(i)<=hlb4(i))THEN
311 lc4(i) = zero
312 lb4(i) = al4(i)
313 ENDIF
314 ENDDO
315C
316 DO i=1,jlt
317C
318 nx1(i) = xi(i)-(x0(i) + lb1(i)*x01(i) + lc1(i)*x02(i))
319 ny1(i) = yi(i)-(y0(i) + lb1(i)*y01(i) + lc1(i)*y02(i))
320 nz1(i) = zi(i)-(z0(i) + lb1(i)*z01(i) + lc1(i)*z02(i))
321 p1(i) = nx1(i)*nx1(i) + ny1(i)*ny1(i) +nz1(i)*nz1(i)
322C
323 nx2(i) = xi(i)-(x0(i) + lb2(i)*x02(i) + lc2(i)*x03(i))
324 ny2(i) = yi(i)-(y0(i) + lb2(i)*y02(i) + lc2(i)*y03(i))
325 nz2(i) = zi(i)-(z0(i) + lb2(i)*z02(i) + lc2(i)*z03(i))
326 p2(i) = nx2(i)*nx2(i) + ny2(i)*ny2(i) +nz2(i)*nz2(i)
327C
328 nx3(i) = xi(i)-(x0(i) + lb3(i)*x03(i) + lc3(i)*x04(i))
329 ny3(i) = yi(i)-(y0(i) + lb3(i)*y03(i) + lc3(i)*y04(i))
330 nz3(i) = zi(i)-(z0(i) + lb3(i)*z03(i) + lc3(i)*z04(i))
331 p3(i) = nx3(i)*nx3(i) + ny3(i)*ny3(i) +nz3(i)*nz3(i)
332C
333 nx4(i) = xi(i)-(x0(i) + lb4(i)*x04(i) + lc4(i)*x01(i))
334 ny4(i) = yi(i)-(y0(i) + lb4(i)*y04(i) + lc4(i)*y01(i))
335 nz4(i) = zi(i)-(z0(i) + lb4(i)*z04(i) + lc4(i)*z01(i))
336 p4(i) = nx4(i)*nx4(i) + ny4(i)*ny4(i) +nz4(i)*nz4(i)
337C
338 ENDDO
339C---------------------
340C PENE INITIALE
341C---------------------
342 RETURN
343 END
344C===============================================================================
345!||====================================================================
346!|| i7dstr3 ../engine/source/interfaces/int07/i7dstk3.F
347!||--- called by ------------------------------------------------------
348!|| imp_i10mainf ../engine/source/interfaces/int10/i10ke3.F
349!|| imp_i7mainf ../engine/source/interfaces/int07/i7ke3.F
350!||====================================================================
351 SUBROUTINE i7dstr3(
352 1 JLT ,CAND_N ,CAND_E ,CN_LOC ,CE_LOC ,
353 2 P1 ,P2 ,P3 ,P4 ,STIF ,
354 3 GAPV ,INACTI ,CAND_P ,INDEX ,JLT_NEW)
355C-----------------------------------------------
356C I m p l i c i t T y p e s
357C-----------------------------------------------
358#include "implicit_f.inc"
359C-----------------------------------------------
360C G l o b a l P a r a m e t e r s
361C-----------------------------------------------
362#include "mvsiz_p.inc"
363C-----------------------------------------------
364C D u m m y A r g u m e n t s
365C-----------------------------------------------
366 INTEGER JLT, JLT_NEW,INACTI, CAND_N(*),CAND_E(*)
367 INTEGER CN_LOC(*),CE_LOC(*),INDEX(MVSIZ)
368 my_real
369 . STIF(MVSIZ),GAPV(MVSIZ), CAND_P(*),
370 . P1(MVSIZ), P2(MVSIZ), P3(MVSIZ), P4(MVSIZ)
371C-----------------------------------------------
372C L o c a l V a r i a b l e s
373C-----------------------------------------------
374 INTEGER I, IG, J
375 my_real
376 . FAC,GAP2,D1,D2,D3,D4,PENE2(MVSIZ)
377C-----------------------------------------------
378 JLT_NEW = 0
379 fac = zep97*zep97
380 DO i=1,jlt
381 gap2=fac*gapv(i)*gapv(i)
382C
383 d1 = max(zero, gap2 - p1(i))
384 d2 = max(zero, gap2 - p2(i))
385 d3 = max(zero, gap2 - p3(i))
386 d4 = max(zero, gap2 - p4(i))
387 pene2(i) = max(d1,d2,d3,d4)
388 ENDDO
389C---------------------
390C PENE INITIALE
391C---------------------
392 IF(inacti==5.OR.inacti==6)THEN
393 DO i=1,jlt
394 IF(pene2(i)>zero.OR.stif(i)==zero)THEN
395 cand_p(index(i))=0
396 ENDIF
397 ENDDO
398 ENDIF
399 DO i=1,jlt
400 IF(pene2(i)>zero.AND.stif(i)/=zero)THEN
401 jlt_new = jlt_new + 1
402 cn_loc(jlt_new) = cand_n(i)
403 ce_loc(jlt_new) = cand_e(i)
404 index(jlt_new)= index(i)
405 ENDIF
406 ENDDO
407C
408 RETURN
409 END
i7dstk3
subroutine i7dstk3(jlt, cand_n, cand_e, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, ix1, ix2, ix3, ix4, nsvg, stif, i3n, gapv, inacti, cand_p, index)
Definition i7dstk3.F:45
i7dstr3
subroutine i7dstr3(jlt, cand_n, cand_e, cn_loc, ce_loc, p1, p2, p3, p4, stif, gapv, inacti, cand_p, index, jlt_new)
Definition i7dstk3.F:355
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21