OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2dst3_27.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "vect07_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i2dst3_27 (first, last, gapv, cand_e, cand_n, tzinf, irtl, st, dmin, ignore, irect, 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)
subroutine choose_main_segment (irect, m_old, m_new, s_new, t_new, s, t, tflag)

Function/Subroutine Documentation

◆ choose_main_segment()

subroutine choose_main_segment ( integer, dimension(4,*) irect,
integer m_old,
integer m_new,
s_new,
t_new,
s,
t,
integer tflag )

Definition at line 230 of file i2dst3_27.F.

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
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
246C-----------------------------------------------
247C
248 IF (irect(3,m_old)==irect(4,m_old)) THEN
249 tflag_old = 1
250 IF ((s>=zero).AND.(t>=zero).AND.(one-s-t>=zero)) THEN
251 interior_old = 1
252 ELSE
253 interior_old = 0
254 ENDIF
255 ELSE
256 tflag_old = 0
257 IF ((abs(s)<=one).AND.(abs(t)<=one)) THEN
258 interior_old = 1
259 ELSE
260 interior_old = 0
261 ENDIF
262 ENDIF
263C
264 IF (tflag==1) THEN
265 IF ((s_new>=zero).AND.(t_new>=zero).AND.(one-s_new-t_new>=zero)) THEN
266 interior = 1
267 ELSE
268 interior = 0
269 ENDIF
270 ELSE
271 IF ((abs(s_new)<=one).AND.(abs(t_new)<=one)) THEN
272 interior = 1
273 ELSE
274 interior = 0
275 ENDIF
276 ENDIF
277C
278C-- Choose segment to keep as main segment
279 switch = 0
280 IF ((tflag_old==0).AND.(tflag==0)) THEN
281C-- two quadrangles
282 IF (max(abs(s_new),abs(t_new))<max(abs(s),abs(t))) switch = 1
283 ELSE
284C-- At least on segment is a triangle
285 IF (interior_old < interior) THEN
286 switch = 1
287 ELSEIF (interior_old == interior) THEN
288C-- The segment with projection closest to center is retained ((1/3,1/3) for triangles and (0,0) for quadrangles)
289 IF (((s_new-third*tflag)**2+(t_new-third*tflag)**2)<
290 . ((s-third*tflag_old)**2+(t-third*tflag_old)**2)) switch = 1
291 ENDIF
292 ENDIF
293C
294 IF (switch == 1) THEN
295 m_old = m_new
296 s = s_new
297 t = t_new
298 ENDIF
299C
300 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21

◆ i2dst3_27()

subroutine i2dst3_27 ( integer, intent(in) first,
integer, intent(in) last,
gapv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
tzinf,
integer, dimension(*) irtl,
st,
dmin,
integer ignore,
integer, dimension(4,*) irect,
integer, dimension(mvsiz), intent(in) ix3,
integer, dimension(mvsiz), intent(in) ix4,
intent(inout) x1,
intent(inout) x2,
intent(inout) x3,
intent(inout) x4,
intent(inout) y1,
intent(inout) y2,
intent(inout) y3,
intent(inout) y4,
intent(inout) z1,
intent(inout) z2,
intent(inout) z3,
intent(inout) z4,
intent(inout) xi,
intent(inout) yi,
intent(inout) zi,
intent(inout) x0,
intent(inout) y0,
intent(inout) z0,
intent(inout) nx1,
intent(inout) ny1,
intent(inout) nz1,
intent(inout) nx2,
intent(inout) ny2,
intent(inout) nz2,
intent(inout) nx3,
intent(inout) ny3,
intent(inout) nz3,
intent(inout) nx4,
intent(inout) ny4,
intent(inout) nz4,
intent(inout) p1,
intent(inout) p2,
intent(inout) p3,
intent(inout) p4,
intent(inout) lb1,
intent(inout) lb2,
intent(inout) lb3,
intent(inout) lb4,
intent(inout) lc1,
intent(inout) lc2,
intent(inout) lc3,
intent(inout) lc4,
intent(inout) s,
intent(inout) t )
Parameters
[in]firstfirst index of the candidates
[in]lastlast index of the candidates

Definition at line 31 of file i2dst3_27.F.

44C============================================================================
45C this routine is called by: i2tri(/inter3d1/i2tri.f)
46C I2BUC1(/inter3d1/i2buc1.F)
47C----------------------------------------------------------------------------
48C cette routine appelle : I7BAR3(/inter3d1/i7bar3.F)
49C============================================================================
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C G l o b a l P a r a m e t e r s
56C-----------------------------------------------
57#include "mvsiz_p.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 integer, intent(in) :: first !< first index of the candidates
62 integer, intent(in) :: last !< last index of the candidates
63 INTEGER CAND_E(*),CAND_N(*),IRTL(*),IGNORE,
64 . IRECT(4,*)
65 my_real
66 . gapv(*),tzinf,st(2,*),dmin(*)
67 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX3,IX4
68 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
69 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
70 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
71 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xi,yi,zi
72 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0
73 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx1,ny1,nz1
74 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx2,ny2,nz2
75 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx3,ny3,nz3
76 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx4,ny4,nz4
77 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: p1,p2,p3,p4
78 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lb1,lb2,lb3,lb4
79 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lc1,lc2,lc3,lc4
80 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: s,t
81C-----------------------------------------------
82C C o m m o n B l o c k s
83C-----------------------------------------------
84#include "param_c.inc"
85#include "vect07_c.inc"
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 INTEGER TFLAG(MVSIZ)
90 INTEGER I, II
91 my_real pene(mvsiz)
92C-----------------------------------------------
93C=======================================================================
94C
95C-----------------------------------------------
96C DERIVED FROM I2DST3 - improved projection on triangles
97C-----------------------------------------------
98C
99 DO i=first,last
100 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
101 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
102 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
103 ENDDO
104C
105 DO i=first,last
106 IF (ix3(i) == ix4(i)) THEN
107 x0(i) = x3(i)
108 y0(i) = y3(i)
109 z0(i) = z3(i)
110 tflag(i) = 1
111 ELSE
112 tflag(i) = 0
113 ENDIF
114 ENDDO
115C
116 CALL i2bar3(first,last,
117 . xi ,yi ,zi ,x0 ,y0 ,
118 . z0 ,x1 ,y1 ,z1 ,x2 ,
119 . y2 ,z2 ,nx1,ny1,nz1,
120 . lb1 ,lc1 ,p1 ,gapv, tflag )
121C
122 CALL i2bar3(first,last,
123 . xi ,yi ,zi ,x0 ,y0 ,
124 . z0 ,x2 ,y2 ,z2 ,x3 ,
125 . y3 ,z3 ,nx2,ny2,nz2,
126 . lb2 ,lc2 ,p2 ,gapv, tflag )
127C
128 CALL i2bar3(first,last,
129 . xi ,yi ,zi ,x0 ,y0 ,
130 . z0 ,x3 ,y3 ,z3 ,x4 ,
131 . y4 ,z4 ,nx3,ny3,nz3,
132 . lb3 ,lc3 ,p3 ,gapv, tflag )
133C
134 CALL i2bar3(first,last,
135 . 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=first,last
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=first,last
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))
181 ENDIF
182 ENDIF
183 ENDDO
184 ELSEIF(ignore==1)THEN
185 DO i=first,last
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))
201 ENDIF
202 ENDIF
203 ENDDO
204 ELSE
205 DO i=first,last
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))
217 ENDIF
218 ENDIF
219 ENDDO
220 ENDIF
221C
222 RETURN
i2bar3
subroutine i2bar3(first, last, xi, yi, zi, xa, ya, za, xb, yb, zb, xc, yc, zc, nx, ny, nz, lb, lc, p, gapv, tflag)
Definition i2dst3.F:254
choose_main_segment
subroutine choose_main_segment(irect, m_old, m_new, s_new, t_new, s, t, tflag)
Definition i2dst3_27.F:231