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

Go to the source code of this file.

Functions/Subroutines

subroutine i7dst3 (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, last)

Function/Subroutine Documentation

◆ i7dst3()

subroutine i7dst3 ( 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,
integer, intent(in) last )
Parameters
[in]lastlast candidat

Definition at line 37 of file i7dst3.F.

46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER, INTENT(IN) :: LAST !< last candidat
58 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX3,IX4
59 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x1,x2,x3,x4
60 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: y1,y2,y3,y4
61 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: z1,z2,z3,z4
62 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xi,yi,zi
63 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: x0,y0,z0
64 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx1,ny1,nz1
65 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx2,ny2,nz2
66 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx3,ny3,nz3
67 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: nx4,ny4,nz4
68 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: p1,p2,p3,p4
69 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lb1,lb2,lb3,lb4
70 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: lc1,lc2,lc3,lc4
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I, IG
75C REAL
76 my_real
77 . al1(mvsiz), al2(mvsiz), al3(mvsiz), al4(mvsiz),
78 . x01(mvsiz), x02(mvsiz), x03(mvsiz), x04(mvsiz),
79 . y01(mvsiz), y02(mvsiz), y03(mvsiz), y04(mvsiz),
80 . z01(mvsiz), z02(mvsiz), z03(mvsiz), z04(mvsiz),
81 . xi1(mvsiz), xi2(mvsiz), xi3(mvsiz), xi4(mvsiz),
82 . yi1(mvsiz), yi2(mvsiz), yi3(mvsiz), yi4(mvsiz),
83 . zi1(mvsiz), zi2(mvsiz), zi3(mvsiz), zi4(mvsiz),
84 . hlb1(mvsiz), hlc1(mvsiz), hlb2(mvsiz),hlc2(mvsiz),
85 . hlb3(mvsiz), hlc3(mvsiz), hlb4(mvsiz),hlc4(mvsiz)
86 my_real
87 . s2,a1,a2,a3,a4,d1,d2,d3,d4,
88 . x12,x23,x34,x41,xi0,sx1,sx2,sx3,sx4,sx0,
89 . y12,y23,y34,y41,yi0,sy1,sy2,sy3,sy4,sy0,
90 . z12,z23,z34,z41,zi0,sz1,sz2,sz3,sz4,sz0,
91 . la, hla, aaa
92C-----------------------------------------------
93 DO 100 i=1,last
94 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
95 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
96 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
97 100 CONTINUE
98C
99 DO 200 i=1,last
100 IF(ix3(i)==ix4(i))THEN
101 x0(i) = x3(i)
102 y0(i) = y3(i)
103 z0(i) = z3(i)
104 ENDIF
105 200 CONTINUE
106C
107 DO i=1,last
108C
109 x01(i) = x1(i) - x0(i)
110 y01(i) = y1(i) - y0(i)
111 z01(i) = z1(i) - z0(i)
112C
113 x02(i) = x2(i) - x0(i)
114 y02(i) = y2(i) - y0(i)
115 z02(i) = z2(i) - z0(i)
116C
117 x03(i) = x3(i) - x0(i)
118 y03(i) = y3(i) - y0(i)
119 z03(i) = z3(i) - z0(i)
120C
121 x04(i) = x4(i) - x0(i)
122 y04(i) = y4(i) - y0(i)
123 z04(i) = z4(i) - z0(i)
124C
125 xi0 = x0(i) - xi(i)
126 yi0 = y0(i) - yi(i)
127 zi0 = z0(i) - zi(i)
128C
129 xi1(i) = x1(i) - xi(i)
130 yi1(i) = y1(i) - yi(i)
131 zi1(i) = z1(i) - zi(i)
132C
133 xi2(i) = x2(i) - xi(i)
134 yi2(i) = y2(i) - yi(i)
135 zi2(i) = z2(i) - zi(i)
136C
137 xi3(i) = x3(i) - xi(i)
138 yi3(i) = y3(i) - yi(i)
139 zi3(i) = z3(i) - zi(i)
140C
141 xi4(i) = x4(i) - xi(i)
142 yi4(i) = y4(i) - yi(i)
143 zi4(i) = z4(i) - zi(i)
144C
145 sx1 = yi0*zi1(i) - zi0*yi1(i)
146 sy1 = zi0*xi1(i) - xi0*zi1(i)
147 sz1 = xi0*yi1(i) - yi0*xi1(i)
148C
149 sx2 = yi0*zi2(i) - zi0*yi2(i)
150 sy2 = zi0*xi2(i) - xi0*zi2(i)
151 sz2 = xi0*yi2(i) - yi0*xi2(i)
152C
153 sx0 = y01(i)*z02(i) - z01(i)*y02(i)
154 sy0 = z01(i)*x02(i) - x01(i)*z02(i)
155 sz0 = x01(i)*y02(i) - y01(i)*x02(i)
156 s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
157C
158 lb1(i) = -(sx0*sx2 + sy0*sy2 + sz0*sz2) * s2
159 lc1(i) = (sx0*sx1 + sy0*sy1 + sz0*sz1) * s2
160C
161 sx3 = yi0*zi3(i) - zi0*yi3(i)
162 sy3 = zi0*xi3(i) - xi0*zi3(i)
163 sz3 = xi0*yi3(i) - yi0*xi3(i)
164C
165 sx0 = y02(i)*z03(i) - z02(i)*y03(i)
166 sy0 = z02(i)*x03(i) - x02(i)*z03(i)
167 sz0 = x02(i)*y03(i) - y02(i)*x03(i)
168 s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
169C
170 lb2(i) = -(sx0*sx3 + sy0*sy3 + sz0*sz3) * s2
171 lc2(i) = (sx0*sx2 + sy0*sy2 + sz0*sz2) * s2
172C
173 sx4 = yi0*zi4(i) - zi0*yi4(i)
174 sy4 = zi0*xi4(i) - xi0*zi4(i)
175 sz4 = xi0*yi4(i) - yi0*xi4(i)
176C
177 sx0 = y03(i)*z04(i) - z03(i)*y04(i)
178 sy0 = z03(i)*x04(i) - x03(i)*z04(i)
179 sz0 = x03(i)*y04(i) - y03(i)*x04(i)
180 s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
181C
182 lb3(i) = -(sx0*sx4 + sy0*sy4 + sz0*sz4) * s2
183 lc3(i) = (sx0*sx3 + sy0*sy3 + sz0*sz3) * s2
184C
185 sx0 = y04(i)*z01(i) - z04(i)*y01(i)
186 sy0 = z04(i)*x01(i) - x04(i)*z01(i)
187 sz0 = x04(i)*y01(i) - y04(i)*x01(i)
188 s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
189C
190 lb4(i) = -(sx0*sx1 + sy0*sy1 + sz0*sz1) * s2
191 lc4(i) = (sx0*sx4 + sy0*sy4 + sz0*sz4) * s2
192C
193 aaa = one/max(em30,x01(i)*x01(i)+y01(i)*y01(i)+z01(i)*z01(i))
194 hlc1(i)= lc1(i)*abs(lc1(i))*aaa
195 hlb4(i)= lb4(i)*abs(lb4(i))*aaa
196 al1(i) = -(xi0*x01(i)+yi0*y01(i)+zi0*z01(i))*aaa
197 al1(i) = max(zero,min(one,al1(i)))
198 aaa = one/max(em30,x02(i)*x02(i)+y02(i)*y02(i)+z02(i)*z02(i))
199 hlc2(i)= lc2(i)*abs(lc2(i))*aaa
200 hlb1(i)= lb1(i)*abs(lb1(i))*aaa
201 al2(i) = -(xi0*x02(i)+yi0*y02(i)+zi0*z02(i))*aaa
202 al2(i) = max(zero,min(one,al2(i)))
203 aaa = one/max(em30,x03(i)*x03(i)+y03(i)*y03(i)+z03(i)*z03(i))
204 hlc3(i)= lc3(i)*abs(lc3(i))*aaa
205 hlb2(i)= lb2(i)*abs(lb2(i))*aaa
206 al3(i) = -(xi0*x03(i)+yi0*y03(i)+zi0*z03(i))*aaa
207 al3(i) = max(zero,min(one,al3(i)))
208 aaa = one/max(em30,x04(i)*x04(i)+y04(i)*y04(i)+z04(i)*z04(i))
209 hlc4(i)= lc4(i)*abs(lc4(i))*aaa
210 hlb3(i)= lb3(i)*abs(lb3(i))*aaa
211 al4(i) = -(xi0*x04(i)+yi0*y04(i)+zi0*z04(i))*aaa
212 al4(i) = max(zero,min(one,al4(i)))
213C
214 ENDDO
215C
216 DO i=1,last
217 x12 = x2(i) - x1(i)
218 y12 = y2(i) - y1(i)
219 z12 = z2(i) - z1(i)
220 la = one - lb1(i) - lc1(i)
221C HLA, HLB1, HLC1 necessaires pour triangle angle obtu
222 aaa = one / max(em20,x12*x12+y12*y12+z12*z12)
223 hla= la*abs(la) * aaa
224 IF(la<zero.AND.
225 + hla<=hlb1(i).AND.hla<=hlc1(i))THEN
226 lb1(i) = (xi2(i)*x12+yi2(i)*y12+zi2(i)*z12) * aaa
227 lb1(i) = max(zero,min(one,lb1(i)))
228 lc1(i) = one - lb1(i)
229 ELSEIF(lb1(i)<zero.AND.
230 + hlb1(i)<=hlc1(i).AND.hlb1(i)<=hla)THEN
231 lb1(i) = zero
232 lc1(i) = al2(i)
233 ELSEIF(lc1(i)<zero.AND.
234 + hlc1(i)<=hla.AND.hlc1(i)<=hlb1(i))THEN
235 lc1(i) = zero
236 lb1(i) = al1(i)
237 ENDIF
238 ENDDO
239C
240 DO i=1,last
241 x23 = x3(i) - x2(i)
242 y23 = y3(i) - y2(i)
243 z23 = z3(i) - z2(i)
244 la = one - lb2(i) - lc2(i)
245C HLA, HLB1, HLC1 necessaires pour triangle angle obtu
246 aaa = one / max(em20,x23*x23+y23*y23+z23*z23)
247 hla= la*abs(la) * aaa
248 IF(la<zero.AND.
249 + hla<=hlb2(i).AND.hla<=hlc2(i))THEN
250 lb2(i) = (xi3(i)*x23+yi3(i)*y23+zi3(i)*z23)*aaa
251 lb2(i) = max(zero,min(one,lb2(i)))
252 lc2(i) = one - lb2(i)
253 ELSEIF(lb2(i)<zero.AND.
254 + hlb2(i)<=hlc2(i).AND.hlb2(i)<=hla)THEN
255 lb2(i) = zero
256 lc2(i) = al3(i)
257 ELSEIF(lc2(i)<zero.AND.
258 + hlc2(i)<=hla.AND.hlc2(i)<=hlb2(i))THEN
259 lc2(i) = zero
260 lb2(i) = al2(i)
261 ENDIF
262 ENDDO
263C
264 DO i=1,last
265 x34 = x4(i) - x3(i)
266 y34 = y4(i) - y3(i)
267 z34 = z4(i) - z3(i)
268 la = one - lb3(i) - lc3(i)
269C HLA, HLB1, HLC1 necessaires pour triangle angle obtu
270 aaa = one / max(em20,x34*x34+y34*y34+z34*z34)
271 hla= la*abs(la) * aaa
272 IF(la<zero.AND.
273 + hla<=hlb3(i).AND.hla<=hlc3(i))THEN
274 lb3(i) = (xi4(i)*x34+yi4(i)*y34+zi4(i)*z34)*aaa
275 lb3(i) = max(zero,min(one,lb3(i)))
276 lc3(i) = one - lb3(i)
277 ELSEIF(lb3(i)<zero.AND.
278 + hlb3(i)<=hlc3(i).AND.hlb3(i)<=hla)THEN
279 lb3(i) = zero
280 lc3(i) = al4(i)
281 ELSEIF(lc3(i)<zero.AND.
282 + hlc3(i)<=hla.AND.hlc3(i)<=hlb3(i))THEN
283 lc3(i) = zero
284 lb3(i) = al3(i)
285 ENDIF
286 ENDDO
287C
288 DO i=1,last
289 x41 = x1(i) - x4(i)
290 y41 = y1(i) - y4(i)
291 z41 = z1(i) - z4(i)
292 la = one - lb4(i) - lc4(i)
293C HLA, HLB1, HLC1 necessaires pour triangle angle obtu
294 aaa = one / max(em20,x41*x41+y41*y41+z41*z41)
295 hla= la*abs(la) * aaa
296 IF(la<zero.AND.
297 + hla<=hlb4(i).AND.hla<=hlc4(i))THEN
298 lb4(i) = (xi1(i)*x41+yi1(i)*y41+zi1(i)*z41)*aaa
299 lb4(i) = max(zero,min(one,lb4(i)))
300 lc4(i) = one - lb4(i)
301 ELSEIF(lb4(i)<zero.AND.
302 + hlb4(i)<=hlc4(i).AND.hlb4(i)<=hla)THEN
303 lb4(i) = zero
304 lc4(i) = al1(i)
305 ELSEIF(lc4(i)<zero.AND.
306 + hlc4(i)<=hla.AND.hlc4(i)<=hlb4(i))THEN
307 lc4(i) = zero
308 lb4(i) = al4(i)
309 ENDIF
310 ENDDO
311C
312 DO i=1,last
313C
314 nx1(i) = xi(i)-(x0(i) + lb1(i)*x01(i) + lc1(i)*x02(i))
315 ny1(i) = yi(i)-(y0(i) + lb1(i)*y01(i) + lc1(i)*y02(i))
316 nz1(i) = zi(i)-(z0(i) + lb1(i)*z01(i) + lc1(i)*z02(i))
317 p1(i) = nx1(i)*nx1(i) + ny1(i)*ny1(i) +nz1(i)*nz1(i)
318C
319 nx2(i) = xi(i)-(x0(i) + lb2(i)*x02(i) + lc2(i)*x03(i))
320 ny2(i) = yi(i)-(y0(i) + lb2(i)*y02(i) + lc2(i)*y03(i))
321 nz2(i) = zi(i)-(z0(i) + lb2(i)*z02(i) + lc2(i)*z03(i))
322 p2(i) = nx2(i)*nx2(i) + ny2(i)*ny2(i) +nz2(i)*nz2(i)
323C
324 nx3(i) = xi(i)-(x0(i) + lb3(i)*x03(i) + lc3(i)*x04(i))
325 ny3(i) = yi(i)-(y0(i) + lb3(i)*y03(i) + lc3(i)*y04(i))
326 nz3(i) = zi(i)-(z0(i) + lb3(i)*z03(i) + lc3(i)*z04(i))
327 p3(i) = nx3(i)*nx3(i) + ny3(i)*ny3(i) +nz3(i)*nz3(i)
328C
329 nx4(i) = xi(i)-(x0(i) + lb4(i)*x04(i) + lc4(i)*x01(i))
330 ny4(i) = yi(i)-(y0(i) + lb4(i)*y04(i) + lc4(i)*y01(i))
331 nz4(i) = zi(i)-(z0(i) + lb4(i)*z04(i) + lc4(i)*z01(i))
332 p4(i) = nx4(i)*nx4(i) + ny4(i)*ny4(i) +nz4(i)*nz4(i)
333C
334 ENDDO
335C
336 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21