OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2dst3_27.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_27 ../starter/source/interfaces/inter3d1/i2dst3_27.F
25!||--- called by ------------------------------------------------------
26!|| i2buc1 ../starter/source/interfaces/inter3d1/i2buc1.F
27!|| i2tri ../starter/source/interfaces/inter3d1/i2tri.F
28!||--- calls -----------------------------------------------------
29!|| choose_main_segment ../starter/source/interfaces/inter3d1/i2dst3_27.F
30!|| i2bar3 ../starter/source/interfaces/inter3d1/i2dst3.F
31!||====================================================================
32 SUBROUTINE i2dst3_27(GAPV,CAND_E ,CAND_N,TZINF,IRTL,ST,DMIN,IGNORE,
33 . THK ,KNOD2ELS,KNOD2ELC,KNOD2ELTG,NOD2ELS,
34 . NOD2ELC,NOD2ELTG,X,IRECT,
35 . NINT,IXC ,IXTG ,THK_PART,IPARTC,GEO ,
36 . NOINT,IXS,IXS10 ,PM,IX3,
37 1 IX4,X1 ,X2 ,X3 ,X4 ,
38 1 Y1 ,Y2 ,Y3 ,Y4 ,Z1 ,
39 2 Z2 ,Z3 ,Z4 ,XI ,YI ,
40 3 ZI ,X0 ,Y0 ,Z0 ,NX1,
41 4 NY1,NZ1,NX2,NY2,NZ2,
42 5 NX3,NY3,NZ3,NX4,NY4,
43 6 NZ4,P1 ,P2 ,P3 ,P4 ,
44 7 LB1,LB2,LB3,LB4,LC1,
45 8 LC2,LC3,LC4,S ,T )
46C============================================================================
47C cette routine est appelee par : I2TRI(/inter3d1/i2tri.F)
48C I2BUC1(/inter3d1/i2buc1.F)
49C----------------------------------------------------------------------------
50C cette routine appelle : I7BAR3(/inter3d1/i7bar3.F)
51C============================================================================
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C G l o b a l P a r a m e t e r s
58C-----------------------------------------------
59#include "mvsiz_p.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER CAND_E(*),CAND_N(*),IRTL(*),IGNORE,
64 . KNOD2ELS(*), KNOD2ELC(*),KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*),
65 . NOD2ELTG(*),IRECT(4,*),NINT,
66 . IXC(NIXC,*),IXTG(NIXTG,*),IPARTC(*),NOINT,IXS(NIXS,*),
67 . IXS10(*)
68 my_real
69 . GAPV(*),TZINF,ST(2,*),DMIN(*),THK(*),X(3,*),THK_PART(*),
70 . GEO(NPROPG,*),PM(*)
71 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX3,IX4
72 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X1,X2,X3,X4
73 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Y1,Y2,Y3,Y4
74 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Z1,Z2,Z3,Z4
75 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: XI,YI,ZI
76 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0
77 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx1,ny1,nz1
78 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx2,ny2,nz2
79 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx3,ny3,nz3
80 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx4,ny4,nz4
81 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: p1,p2,p3,p4
82 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lb1,lb2,lb3,lb4
83 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lc1,lc2,lc3,lc4
84 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: s,t
85C-----------------------------------------------
86C C o m m o n B l o c k s
87C-----------------------------------------------
88#include "param_c.inc"
89#include "vect07_c.inc"
90C-----------------------------------------------
91C L o c a l V a r i a b l e s
92C-----------------------------------------------
93 INTEGER TFLAG(MVSIZ)
94 INTEGER I, II
95 my_real pene(mvsiz)
96C-----------------------------------------------
97C=======================================================================
98C
99C-----------------------------------------------
100C DERIVED FROM I2DST3 - improved projection on triangles
101C-----------------------------------------------
102C
103 DO i=lft,llt
104 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
105 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
106 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
107 ENDDO
108C
109 DO i=lft,llt
110 IF (ix3(i) == ix4(i)) THEN
111 x0(i) = x3(i)
112 y0(i) = y3(i)
113 z0(i) = z3(i)
114 tflag(i) = 1
115 ELSE
116 tflag(i) = 0
117 ENDIF
118 ENDDO
119C
120 CALL i2bar3(xi ,yi ,zi ,x0 ,y0 ,
121 . z0 ,x1 ,y1 ,z1 ,x2 ,
122 . y2 ,z2 ,nx1,ny1,nz1,
123 . lb1 ,lc1 ,p1 ,gapv, tflag )
124C
125 CALL i2bar3(xi ,yi ,zi ,x0 ,y0 ,
126 . z0 ,x2 ,y2 ,z2 ,x3 ,
127 . y3 ,z3 ,nx2,ny2,nz2,
128 . lb2 ,lc2 ,p2 ,gapv, tflag )
129C
130 CALL i2bar3(xi ,yi ,zi ,x0 ,y0 ,
131 . z0 ,x3 ,y3 ,z3 ,x4 ,
132 . y4 ,z4 ,nx3,ny3,nz3,
133 . lb3 ,lc3 ,p3 ,gapv, tflag )
134C
135 CALL i2bar3(xi ,yi ,zi ,x0 ,y0 ,
136 . z0 ,x4 ,y4 ,z4 ,x1 ,
137 . y1 ,z1 ,nx4,ny4,nz4,
138 . lb4 ,lc4 ,p4 ,gapv, tflag )
139C
140 DO i=lft,llt
141 IF (tflag(i) == 1) THEN
142 pene(i) = p1(i)
143 s(i) = lb1(i)
144 t(i) = lc1(i)
145 ELSE
146 pene(i) = max(p1(i),p2(i),p3(i),p4(i))
147 IF(p1(i)==pene(i))THEN
148 s(i) = -lb1(i) + lc1(i)
149 t(i) = -lb1(i) - lc1(i)
150 ELSEIF(p2(i)==pene(i))THEN
151 s(i) = lb2(i) + lc2(i)
152 t(i) = -lb2(i) + lc2(i)
153 ELSEIF(p3(i)==pene(i))THEN
154 s(i) = lb3(i) - lc3(i)
155 t(i) = lb3(i) + lc3(i)
156 ELSEIF(p4(i)==pene(i))THEN
157 s(i) = -lb4(i) - lc4(i)
158 t(i) = lb4(i) - lc4(i)
159 ELSE
160 s(i) = zero
161 t(i) = zero
162 ENDIF
163 ENDIF
164 ENDDO
165C
166 IF(ignore==2 .OR. ignore == 3)THEN
167 DO i=lft,llt
168 IF(pene(i)>zero .AND.
169 . (s(i) < onep5 .AND.
170 . t(i) < onep5 .AND.
171 . s(i) >-onep5 .AND.
172 . t(i) >-onep5))THEN
173 ii=cand_n(i)
174 IF(gapv(i) - pene(i)<dmin(ii))THEN
175 dmin(ii)=gapv(i)-pene(i)
176 irtl(ii)=cand_e(i)
177 st(1,ii) = s(i)
178 st(2,ii) = t(i)
179 ELSEIF(gapv(i) - pene(i)==dmin(ii))THEN
180 CALL choose_main_segment(irect,irtl(ii),cand_e(i),s(i),t(i),st(1,ii),st(2,ii),tflag(i),ii)
181 ENDIF
182 ENDIF
183 ENDDO
184 ELSEIF(ignore==1)THEN
185 DO i=lft,llt
186C
187 IF(pene(i)>zero .AND.
188 . (s(i) < onep5 .AND.
189 . t(i) < onep5 .AND.
190 . s(i) >-onep5 .AND.
191 . t(i) >-onep5)) THEN
192 ii=cand_n(i)
193
194 IF(tzinf - pene(i)<dmin(ii))THEN
195 dmin(ii)=tzinf - pene(i)
196 irtl(ii)=cand_e(i)
197 st(1,ii) = s(i)
198 st(2,ii) = t(i)
199 ELSEIF(tzinf - pene(i)==dmin(ii))THEN
200 CALL choose_main_segment(irect,irtl(ii),cand_e(i),s(i),t(i),st(1,ii),st(2,ii),tflag(i),ii)
201 ENDIF
202 ENDIF
203 ENDDO
204 ELSE
205 DO i=lft,llt
206C
207 IF(pene(i)>zero) THEN
208 ii=cand_n(i)
209
210 IF(tzinf - pene(i)<dmin(ii))THEN
211 dmin(ii)=tzinf - pene(i)
212 irtl(ii)=cand_e(i)
213 st(1,ii) = s(i)
214 st(2,ii) = t(i)
215 ELSEIF(tzinf - pene(i)==dmin(ii))THEN
216 CALL choose_main_segment(irect,irtl(ii),cand_e(i),s(i),t(i),st(1,ii),st(2,ii),tflag(i),ii)
217 ENDIF
218 ENDIF
219 ENDDO
220 ENDIF
221C
222 RETURN
223 END
224C
225!||====================================================================
226!|| choose_main_segment ../starter/source/interfaces/inter3d1/i2dst3_27.F
227!||--- called by ------------------------------------------------------
228!|| i2dst3_27 ../starter/source/interfaces/inter3d1/i2dst3_27.F
229!||====================================================================
230 SUBROUTINE choose_main_segment(IRECT,M_OLD,M_NEW,S_NEW,T_NEW,S,T,TFLAG,II)
231C============================================================================
232C-----------------------------------------------
233C I m p l i c i t T y p e s
234C-----------------------------------------------
235#include "implicit_f.inc"
236C-----------------------------------------------
237C D u m m y A r g u m e n t s
238C-----------------------------------------------
239 INTEGER IRECT(4,*),M_OLD,M_NEW,TFLAG,II
240 my_real
241 . S_NEW,T_NEW,S,T
242C-----------------------------------------------
243C L o c a l V a r i a b l e s
244C-----------------------------------------------
245 INTEGER TFLAG_OLD,INTERIOR_OLD,INTERIOR,SWITCH
246 my_real
247 . S1,T1,S2,T2
248C-----------------------------------------------
249C
250 IF (IRECT(3,M_OLD)==irect(4,m_old)) THEN
251 tflag_old = 1
252 IF ((s>=zero).AND.(t>=zero).AND.(one-s-t>=zero)) THEN
253 interior_old = 1
254 ELSE
255 interior_old = 0
256 ENDIF
257 ELSE
258 tflag_old = 0
259 IF ((abs(s)<=one).AND.(abs(t)<=one)) THEN
260 interior_old = 1
261 ELSE
262 interior_old = 0
263 ENDIF
264 ENDIF
265C
266 IF (tflag==1) THEN
267 IF ((s_new>=zero).AND.(t_new>=zero).AND.(one-s_new-t_new>=zero)) THEN
268 interior = 1
269 ELSE
270 interior = 0
271 ENDIF
272 ELSE
273 IF ((abs(s_new)<=one).AND.(abs(t_new)<=one)) THEN
274 interior = 1
275 ELSE
276 interior = 0
277 ENDIF
278 ENDIF
279C
280C-- Choose segment to keep as main segment
281 switch = 0
282 IF ((tflag_old==0).AND.(tflag==0)) THEN
283C-- two quadrangles
284 IF (max(abs(s_new),abs(t_new))<max(abs(s),abs(t))) switch = 1
285 ELSE
286C-- At least on segment is a triangle
287 IF (interior_old < interior) THEN
288 switch = 1
289 ELSEIF (interior_old == interior) THEN
290C-- The segment with projection clostet to center is retained ((1/3,1/3) for triangles and (0,0) for quadrangles)
291 IF (((s_new-third*tflag)**2+(t_new-third*tflag)**2)<
292 . ((s-third*tflag_old)**2+(t-third*tflag_old)**2)) switch = 1
293 ENDIF
294 ENDIF
295C
296 IF (switch == 1) THEN
297 m_old = m_new
298 s = s_new
299 t = t_new
300 ENDIF
301C
302 RETURN
303 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
choose_main_segment
subroutine choose_main_segment(irect, m_old, m_new, s_new, t_new, s, t, tflag, ii)
Definition i2dst3_27.F:231
i2dst3_27
subroutine i2dst3_27(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_27.F:46
max
#define max(a, b)
Definition macros.h:21