OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i2dst3.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 (first, last, gapv, cand_e, cand_n, tzinf, irtl, st, dmin, ignore, 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 i2bar3 (first, last, xi, yi, zi, xa, ya, za, xb, yb, zb, xc, yc, zc, nx, ny, nz, lb, lc, p, gapv, tflag)

Function/Subroutine Documentation

◆ i2bar3()

subroutine i2bar3 ( integer, intent(in) first,
integer, intent(in) last,
xi,
yi,
zi,
xa,
ya,
za,
xb,
yb,
zb,
xc,
yc,
zc,
nx,
ny,
nz,
lb,
lc,
p,
gapv,
integer, dimension(*) tflag )
Parameters
[in]firstfirst index of the candidates
[in]lastlast index of the candidates

Definition at line 249 of file i2dst3.F.

254C============================================================================
255C-----------------------------------------------
256C I m p l i c i t T y p e s
257C-----------------------------------------------
258#include "implicit_f.inc"
259C-----------------------------------------------
260C D u m m y A r g u m e n t s
261C-----------------------------------------------
262 INTEGER TFLAG(*)
263 integer, intent(in) :: first !< first index of the candidates
264 integer, intent(in) :: last !< last index of the candidates
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 = first,last
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=first,last
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=first,last
366 p(i) = max(zero, gapv(i) - p(i))
367 ENDDO
368C
369 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
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

◆ i2dst3()

subroutine i2dst3 ( 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(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(in) nx1,
intent(in) ny1,
intent(in) nz1,
intent(in) nx2,
intent(in) ny2,
intent(in) nz2,
intent(in) nx3,
intent(in) ny3,
intent(in) nz3,
intent(in) nx4,
intent(in) ny4,
intent(in) nz4,
intent(in) p1,
intent(in) p2,
intent(in) p3,
intent(in) p4,
intent(in) lb1,
intent(in) lb2,
intent(in) lb3,
intent(in) lb4,
intent(in) lc1,
intent(in) lc2,
intent(in) lc3,
intent(in) lc4,
intent(inout) s,
intent(inout) t )
Parameters
[in]firstfirst index of the candidates
[in]lastlast index of the candidates

Definition at line 30 of file i2dst3.F.

42C============================================================================
43C this routine is called by: I2TRI(/inter3d1/i2tri.F)
44C I2BUC1(/inter3d1/i2buc1.F)
45C----------------------------------------------------------------------------
46C cette routine appelle : I7BAR3(/inter3d1/i7bar3.F)
47C============================================================================
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C G l o b a l P a r a m e t e r s
54C-----------------------------------------------
55#include "mvsiz_p.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 integer, intent(in) :: first !< first index of the candidates
60 integer, intent(in) :: last !< last index of the candidates
61 INTEGER CAND_E(*),CAND_N(*),IRTL(*),IGNORE
62 my_real
63 . gapv(*),tzinf,st(2,*),dmin(*)
64 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX3,IX4
65 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
66 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
67 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
68 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xi,yi,zi
69 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0
70 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx1,ny1,nz1
71 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx2,ny2,nz2
72 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx3,ny3,nz3
73 my_real, DIMENSION(MVSIZ), INTENT(IN) :: nx4,ny4,nz4
74 my_real, DIMENSION(MVSIZ), INTENT(IN) :: p1,p2,p3,p4
75 my_real, DIMENSION(MVSIZ), INTENT(IN) :: lb1,lb2,lb3,lb4
76 my_real, DIMENSION(MVSIZ), INTENT(IN) :: lc1,lc2,lc3,lc4
77 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: s,t
78C-----------------------------------------------
79C C o m m o n B l o c k s
80C-----------------------------------------------
81#include "param_c.inc"
82#include "vect07_c.inc"
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 INTEGER TFLAG(MVSIZ)
87 INTEGER I, II
88 my_real pene(mvsiz)
89C-----------------------------------------------
90C=======================================================================
91 DO i=first,last
92 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
93 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
94 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
95 ENDDO
96C
97 DO i=first,last
98 IF (ix3(i) == ix4(i)) THEN
99 x0(i) = x3(i)
100 y0(i) = y3(i)
101 z0(i) = z3(i)
102 tflag(i) = 1
103 ELSE
104 tflag(i) = 0
105 ENDIF
106 ENDDO
107C
108 CALL i2bar3(first,last,
109 . xi ,yi ,zi ,x0 ,y0 ,
110 . z0 ,x1 ,y1 ,z1 ,x2 ,
111 . y2 ,z2 ,nx1,ny1,nz1,
112 . lb1 ,lc1 ,p1 ,gapv, tflag )
113C
114 CALL i2bar3(first,last,
115 . xi ,yi ,zi ,x0 ,y0 ,
116 . z0 ,x2 ,y2 ,z2 ,x3 ,
117 . y3 ,z3 ,nx2,ny2,nz2,
118 . lb2 ,lc2 ,p2 ,gapv, tflag )
119C
120 CALL i2bar3(first,last,
121 . xi ,yi ,zi ,x0 ,y0 ,
122 . z0 ,x3 ,y3 ,z3 ,x4 ,
123 . y4 ,z4 ,nx3,ny3,nz3,
124 . lb3 ,lc3 ,p3 ,gapv, tflag )
125C
126 CALL i2bar3(first,last,
127 . xi ,yi ,zi ,x0 ,y0 ,
128 . z0 ,x4 ,y4 ,z4 ,x1 ,
129 . y1 ,z1 ,nx4,ny4,nz4,
130 . lb4 ,lc4 ,p4 ,gapv, tflag )
131C
132 DO i=first,last
133 pene(i) = max(p1(i),p2(i),p3(i),p4(i))
134C
135 IF(p1(i)==pene(i))THEN
136 s(i) = -lb1(i) + lc1(i)
137 t(i) = -lb1(i) - lc1(i)
138 ELSEIF(p2(i)==pene(i))THEN
139 s(i) = lb2(i) + lc2(i)
140 t(i) = -lb2(i) + lc2(i)
141 ELSEIF(p3(i)==pene(i))THEN
142 s(i) = lb3(i) - lc3(i)
143 t(i) = lb3(i) + lc3(i)
144 ELSEIF(p4(i)==pene(i))THEN
145 s(i) = -lb4(i) - lc4(i)
146 t(i) = lb4(i) - lc4(i)
147 ELSE
148 s(i) = zero
149 t(i) = zero
150 ENDIF
151 ENDDO
152C
153 DO i=first,last
154 IF (tflag(i) == 1) THEN
155 pene(i) = p1(i)
156 t(i)= one - two*lb1(i) - two*lc1(i)
157 IF (t(i) < one-em10) THEN
158 s(i)= (lc1(i)-lb1(i))/(lc1(i)+lb1(i))
159 ELSEIF (lb1(i) < -em10) THEN
160 s(i)= two
161 ELSEIF (lc1(i) < -em10) THEN
162 s(i)= -two
163 ELSE
164 s(i)= zero
165 ENDIF
166 ENDIF
167 ENDDO
168C
169 IF(ignore==2 .OR. ignore == 3)THEN
170 DO i=first,last
171 IF(pene(i)>zero .AND.
172 . (s(i) < onep5 .AND.
173 . t(i) < onep5 .AND.
174 . s(i) >-onep5 .AND.
175 . t(i) >-onep5))THEN
176 ii=cand_n(i)
177 IF(gapv(i) - pene(i)<dmin(ii))THEN
178 dmin(ii)=gapv(i)-pene(i)
179 irtl(ii)=cand_e(i)
180 st(1,ii) = s(i)
181 st(2,ii) = t(i)
182 ELSEIF(gapv(i) - pene(i)==dmin(ii))THEN
183 IF(max(abs(s(i)) ,abs(t(i) ))<
184 . max(abs(st(1,ii)),abs(st(2,ii))) )THEN
185 irtl(ii)=cand_e(i)
186 st(1,ii) = s(i)
187 st(2,ii) = t(i)
188 ENDIF
189 ENDIF
190 ENDIF
191 ENDDO
192 ELSEIF(ignore==1)THEN
193 DO i=first,last
194C
195 IF(pene(i)>zero .AND.
196 . (s(i) < onep5 .AND.
197 . t(i) < onep5 .AND.
198 . s(i) >-onep5 .AND.
199 . t(i) >-onep5)) THEN
200 ii=cand_n(i)
201
202 IF(tzinf - pene(i)<dmin(ii))THEN
203 dmin(ii)=tzinf - pene(i)
204 irtl(ii)=cand_e(i)
205 st(1,ii) = s(i)
206 st(2,ii) = t(i)
207 ELSEIF(tzinf - pene(i)==dmin(ii))THEN
208 IF(max(abs(s(i)) ,abs(t(i) ))<
209 . max(abs(st(1,ii)),abs(st(2,ii))) )THEN
210 irtl(ii)=cand_e(i)
211 st(1,ii) = s(i)
212 st(2,ii) = t(i)
213 ENDIF
214 ENDIF
215 ENDIF
216 ENDDO
217 ELSE
218 DO i=first,last
219C
220 IF(pene(i)>zero) THEN
221 ii=cand_n(i)
222 IF(tzinf - pene(i)<dmin(ii))THEN
223 dmin(ii)=tzinf - pene(i)
224 irtl(ii)=cand_e(i)
225 st(1,ii) = s(i)
226 st(2,ii) = t(i)
227 ELSEIF(tzinf - pene(i)==dmin(ii))THEN
228 IF(max(abs(s(i)) ,abs(t(i) ))<
229 . max(abs(st(1,ii)),abs(st(2,ii))) )THEN
230 irtl(ii)=cand_e(i)
231 st(1,ii) = s(i)
232 st(2,ii) = t(i)
233 ENDIF
234 ENDIF
235 ENDIF
236 ENDDO
237 ENDIF
238C
239 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