OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2dst3.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!|| i2dst3 ../starter/source/interfaces/inter3d1/i2dst3.F
25!||--- called by ------------------------------------------------------
26!|| i2buc1 ../starter/source/interfaces/inter3d1/i2buc1.F
27!|| i2tri ../starter/source/interfaces/inter3d1/i2tri.F
28!||--- calls -----------------------------------------------------
29!|| i2bar3 ../starter/source/interfaces/inter3d1/i2dst3.F
30!||====================================================================
31 SUBROUTINE i2dst3(GAPV,CAND_E ,CAND_N,TZINF,IRTL,ST,DMIN,IGNORE,
32 . THK ,KNOD2ELS,KNOD2ELC,KNOD2ELTG,NOD2ELS,
33 . NOD2ELC,NOD2ELTG,X,IRECT,
34 . NINT,IXC ,IXTG ,THK_PART,IPARTC,GEO ,
35 . NOINT,IXS,IXS10 ,PM,IX3,
36 1 IX4,X1 ,X2 ,X3 ,X4 ,
37 1 Y1 ,Y2 ,Y3 ,Y4 ,Z1 ,
38 2 Z2 ,Z3 ,Z4 ,XI ,YI ,
39 3 ZI ,X0 ,Y0 ,Z0 ,NX1,
40 4 NY1,NZ1,NX2,NY2,NZ2,
41 5 NX3,NY3,NZ3,NX4,NY4,
42 6 NZ4,P1 ,P2 ,P3 ,P4 ,
43 7 LB1,LB2,LB3,LB4,LC1,
44 8 LC2,LC3,LC4,S ,T )
45C============================================================================
46C cette routine est appelee par : I2TRI(/inter3d1/i2tri.F)
47C I2BUC1(/inter3d1/i2buc1.F)
48C----------------------------------------------------------------------------
49C cette routine appelle : I7BAR3(/inter3d1/i7bar3.F)
50C============================================================================
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C G l o b a l P a r a m e t e r s
57C-----------------------------------------------
58#include "mvsiz_p.inc"
59C-----------------------------------------------
60C D u m m y A r g u m e n t s
61C-----------------------------------------------
62 INTEGER CAND_E(*),CAND_N(*),IRTL(*),IGNORE,
63 . KNOD2ELS(*), KNOD2ELC(*),KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
64 . NOD2ELTG(*),IRECT(4,*),NINT,
65 . IXC(NIXC,*),IXTG(NIXTG,*),IPARTC(*),NOINT,IXS(NIXS,*),
66 . IXS10(*)
67 my_real
68 . GAPV(*),TZINF,ST(2,*),DMIN(*),THK(*),X(3,*),THK_PART(*),
69 . GEO(NPROPG,*),PM(*)
70 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX3,IX4
71 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X1,X2,X3,X4
72 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Y1,Y2,Y3,Y4
73 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Z1,Z2,Z3,Z4
74 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: XI,YI,ZI
75 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0
76 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx1,ny1,nz1
77 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx2,ny2,nz2
78 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx3,ny3,nz3
79 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx4,ny4,nz4
80 my_real, DIMENSION(MVSIZ), INTENT(IN) :: p1,p2,p3,p4
81 my_real, DIMENSION(MVSIZ), INTENT(IN) :: lb1,lb2,lb3,lb4
82 my_real, DIMENSION(MVSIZ), INTENT(IN) :: lc1,lc2,lc3,lc4
83 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: s,t
84C-----------------------------------------------
85C C o m m o n B l o c k s
86C-----------------------------------------------
87#include "param_c.inc"
88#include "vect07_c.inc"
89C-----------------------------------------------
90C L o c a l V a r i a b l e s
91C-----------------------------------------------
92 INTEGER TFLAG(MVSIZ)
93 INTEGER I, II
94 my_real pene(mvsiz)
95C-----------------------------------------------
96C=======================================================================
97 DO i=lft,llt
98 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
99 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
100 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
101 ENDDO
102C
103 DO i=lft,llt
104 IF (ix3(i) == ix4(i)) THEN
105 x0(i) = x3(i)
106 y0(i) = y3(i)
107 z0(i) = z3(i)
108 tflag(i) = 1
109 ELSE
110 tflag(i) = 0
111 ENDIF
112 ENDDO
113C
114 CALL i2bar3(xi ,yi ,zi ,x0 ,y0 ,
115 . z0 ,x1 ,y1 ,z1 ,x2 ,
116 . y2 ,z2 ,nx1,ny1,nz1,
117 . lb1 ,lc1 ,p1 ,gapv, tflag )
118C
119 CALL i2bar3(xi ,yi ,zi ,x0 ,y0 ,
120 . z0 ,x2 ,y2 ,z2 ,x3 ,
121 . y3 ,z3 ,nx2,ny2,nz2,
122 . lb2 ,lc2 ,p2 ,gapv, tflag )
123C
124 CALL i2bar3(xi ,yi ,zi ,x0 ,y0 ,
125 . z0 ,x3 ,y3 ,z3 ,x4 ,
126 . y4 ,z4 ,nx3,ny3,nz3,
127 . lb3 ,lc3 ,p3 ,gapv, tflag )
128C
129 CALL i2bar3(xi ,yi ,zi ,x0 ,y0 ,
130 . z0 ,x4 ,y4 ,z4 ,x1 ,
131 . y1 ,z1 ,nx4,ny4,nz4,
132 . lb4 ,lc4 ,p4 ,gapv, tflag )
133C
134 DO i=lft,llt
135 pene(i) = max(p1(i),p2(i),p3(i),p4(i))
136C
137 IF(p1(i)==pene(i))THEN
138 s(i) = -lb1(i) + lc1(i)
139 t(i) = -lb1(i) - lc1(i)
140 ELSEIF(p2(i)==pene(i))THEN
141 s(i) = lb2(i) + lc2(i)
142 t(i) = -lb2(i) + lc2(i)
143 ELSEIF(p3(i)==pene(i))THEN
144 s(i) = lb3(i) - lc3(i)
145 t(i) = lb3(i) + lc3(i)
146 ELSEIF(p4(i)==pene(i))THEN
147 s(i) = -lb4(i) - lc4(i)
148 t(i) = lb4(i) - lc4(i)
149 ELSE
150 s(i) = zero
151 t(i) = zero
152 ENDIF
153 ENDDO
154C
155 DO i=lft,llt
156 IF (tflag(i) == 1) THEN
157 pene(i) = p1(i)
158 t(i)= one - two*lb1(i) - two*lc1(i)
159 IF (t(i) < one-em10) THEN
160 s(i)= (lc1(i)-lb1(i))/(lc1(i)+lb1(i))
161 ELSEIF (lb1(i) < -em10) THEN
162 s(i)= two
163 ELSEIF (lc1(i) < -em10) THEN
164 s(i)= -two
165 ELSE
166 s(i)= zero
167 ENDIF
168 ENDIF
169 ENDDO
170C
171 IF(ignore==2 .OR. ignore == 3)THEN
172 DO i=lft,llt
173 IF(pene(i)>zero .AND.
174 . (s(i) < onep5 .AND.
175 . t(i) < onep5 .AND.
176 . s(i) >-onep5 .AND.
177 . t(i) >-onep5))THEN
178 ii=cand_n(i)
179 IF(gapv(i) - pene(i)<dmin(ii))THEN
180 dmin(ii)=gapv(i)-pene(i)
181 irtl(ii)=cand_e(i)
182 st(1,ii) = s(i)
183 st(2,ii) = t(i)
184 ELSEIF(gapv(i) - pene(i)==dmin(ii))THEN
185 IF(max(abs(s(i)) ,abs(t(i) ))<
186 . max(abs(st(1,ii)),abs(st(2,ii))) )THEN
187 irtl(ii)=cand_e(i)
188 st(1,ii) = s(i)
189 st(2,ii) = t(i)
190 ENDIF
191 ENDIF
192 ENDIF
193 ENDDO
194 ELSEIF(ignore==1)THEN
195 DO i=lft,llt
196C
197 IF(pene(i)>zero .AND.
198 . (s(i) < onep5 .AND.
199 . t(i) < onep5 .AND.
200 . s(i) >-onep5 .AND.
201 . t(i) >-onep5)) THEN
202 ii=cand_n(i)
203
204 IF(tzinf - pene(i)<dmin(ii))THEN
205 dmin(ii)=tzinf - pene(i)
206 irtl(ii)=cand_e(i)
207 st(1,ii) = s(i)
208 st(2,ii) = t(i)
209 ELSEIF(tzinf - pene(i)==dmin(ii))THEN
210 IF(max(abs(s(i)) ,abs(t(i) ))<
211 . max(abs(st(1,ii)),abs(st(2,ii))) )THEN
212 irtl(ii)=cand_e(i)
213 st(1,ii) = s(i)
214 st(2,ii) = t(i)
215 ENDIF
216 ENDIF
217 ENDIF
218 ENDDO
219 ELSE
220 DO i=lft,llt
221C
222 IF(pene(i)>zero) THEN
223 ii=cand_n(i)
224
225 IF(tzinf - pene(i)<dmin(ii))THEN
226 dmin(ii)=tzinf - pene(i)
227 irtl(ii)=cand_e(i)
228 st(1,ii) = s(i)
229 st(2,ii) = t(i)
230 ELSEIF(tzinf - pene(i)==dmin(ii))THEN
231 IF(max(abs(s(i)) ,abs(t(i) ))<
232 . max(abs(st(1,ii)),abs(st(2,ii))) )THEN
233 irtl(ii)=cand_e(i)
234 st(1,ii) = s(i)
235 st(2,ii) = t(i)
236 ENDIF
237 ENDIF
238 ENDIF
239 ENDDO
240 ENDIF
241C
242 RETURN
243 END
244!||====================================================================
245!|| i2bar3 ../starter/source/interfaces/inter3d1/i2dst3.f
246!||--- called by ------------------------------------------------------
247!|| i2dst3 ../starter/source/interfaces/inter3d1/i2dst3.F
248!|| i2dst3_27 ../starter/source/interfaces/inter3d1/i2dst3_27.F
249!||--- calls -----------------------------------------------------
250!|| i7lin3 ../starter/source/interfaces/inter3d1/i7lin3.F
251!||====================================================================
252 SUBROUTINE i2bar3(XI,YI,ZI,XA,YA,
253 . ZA,XB,YB,ZB,XC,
254 . YC,ZC,NX,NY,NZ,
255 . LB,LC,P,GAPV, TFLAG)
256C============================================================================
257C-----------------------------------------------
258C I m p l i c i t T y p e s
259C-----------------------------------------------
260#include "implicit_f.inc"
261C-----------------------------------------------
262C D u m m y A r g u m e n t s
263C-----------------------------------------------
264 INTEGER TFLAG(*)
265C REAL
266 my_real
267 . XI(*),YI(*),ZI(*),XA(*),YA(*),ZA(*),
268 . xb(*),yb(*),zb(*),xc(*),yc(*),zc(*),
269 . nx(*),ny(*),nz(*),lb(*),lc(*),p(*),gapv(*)
270C-----------------------------------------------
271C C o m m o n B l o c k s
272C-----------------------------------------------
273#include "vect07_c.inc"
274C-----------------------------------------------
275C L o c a l V a r i a b l e s
276C-----------------------------------------------
277 INTEGER I
278C REAL
279 my_real
280 . xpa,ypa,zpa,xpb,ypb,zpb,xpc,ypc,zpc,
281 . xab,yab,zab,xac,yac,zac,alp,
282 . s2,sx,sy,sz,xp,yp,zp
283C--------1---------2---------3---------4---------5---------6---------7--
284 DO i = lft , llt
285 xab = xb(i) - xa(i)
286 yab = yb(i) - ya(i)
287 zab = zb(i) - za(i)
288C
289 xac = xc(i) - xa(i)
290 yac = yc(i) - ya(i)
291 zac = zc(i) - za(i)
292C
293 nx(i) = yab*zac - zab*yac
294 ny(i) = zab*xac - xab*zac
295 nz(i) = xab*yac - yab*xac
296C
297 s2 = max(em20,sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2))
298 nx(i) = nx(i) / s2
299 ny(i) = ny(i) / s2
300 nz(i) = nz(i) / s2
301C
302 p(i) = nx(i) * (xi(i) - xa(i))
303 . + ny(i) * (yi(i) - ya(i))
304 . + nz(i) * (zi(i) - za(i))
305C
306 xp = xi(i) - nx(i) * p(i)
307 yp = yi(i) - ny(i) * p(i)
308 zp = zi(i) - nz(i) * p(i)
309C
310 xpa = xa(i)-xp
311 ypa = ya(i)-yp
312 zpa = za(i)-zp
313C
314 xpb = xb(i)-xp
315 ypb = yb(i)-yp
316 zpb = zb(i)-zp
317C
318 xpc = xc(i)-xp
319 ypc = yc(i)-yp
320 zpc = zc(i)-zp
321C
322 sx = ypc*zpa - zpc*ypa
323 sy = zpc*xpa - xpc*zpa
324 sz = xpc*ypa - ypc*xpa
325C
326 lb(i) = (nx(i)*sx + ny(i)*sy + nz(i)*sz) / s2
327C
328 sx = ypa*zpb - zpa*ypb
329 sy = zpa*xpb - xpa*zpb
330 sz = xpa*ypb - ypa*xpb
331C
332 lc(i) = (nx(i)*sx + ny(i)*sy + nz(i)*sz) / s2
333 ENDDO
334C
335 DO i=lft,llt
336 IF(one-lb(i)-lc(i)<zero)THEN
337 CALL i7lin3(xi(i),yi(i),zi(i),xb(i),yb(i),
338 . zb(i),xc(i),yc(i),zc(i),nx(i),
339 . ny(i),nz(i),p(i),alp)
340 ELSEIF(lb(i)<zero)THEN
341 CALL i7lin3(xi(i),yi(i),zi(i),xc(i),yc(i),
342 . zc(i),xa(i),ya(i),za(i),nx(i),
343 . ny(i),nz(i),p(i),alp)
344 IF (tflag(i) == 0) THEN ! only necessary for warped 4 node segments
345 lc(i) = one - alp
346 lb(i) = zero
347 ENDIF
348 ELSEIF(lc(i)<zero)THEN
349 CALL i7lin3(xi(i),yi(i),zi(i),xa(i),ya(i),
350 . za(i),xb(i),yb(i),zb(i),nx(i),
351 . ny(i),nz(i),p(i),alp)
352 IF (tflag(i) == 0) THEN ! only necessary for warped 4 node segments
353 lb(i) = alp
354 lc(i) = zero
355 ENDIF
356 ELSEIF(p(i)<zero)THEN
357
358 nx(i) = -nx(i)
359 ny(i) = -ny(i)
360 nz(i) = -nz(i)
361 p(i) = -p(i)
362 ENDIF
363 ENDDO
364C
365 DO i=lft,llt
366 p(i) = max(zero, gapv(i) - p(i))
367 ENDDO
368C
369 RETURN
370 END
i2bar3
subroutine i2bar3(xi, yi, zi, xa, ya, za, xb, yb, zb, xc, yc, zc, nx, ny, nz, lb, lc, p, gapv, tflag)
Definition i2dst3.F:256
i2dst3
subroutine i2dst3(gapv, cand_e, cand_n, tzinf, irtl, st, dmin, ignore, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, x, irect, nint, ixc, ixtg, thk_part, ipartc, geo, noint, ixs, ixs10, pm, ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, s, t)
Definition i2dst3.F:45
i7lin3
subroutine i7lin3(xi, yi, zi, xa, ya, za, xb, yb, zb, nx, ny, nz, p, alp)
Definition i7lin3.F:29
max
#define max(a, b)
Definition macros.h:21
starter
program starter
Definition starter.F:39