OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25pen3_e2s.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!|| i25pen3_e2s ../engine/source/interfaces/intsort/i25pen3_e2s.F
25!||--- called by ------------------------------------------------------
26!|| i25sto_e2s ../engine/source/interfaces/intsort/i25sto_e2s.F
27!||--- uses -----------------------------------------------------
28!|| tri7box ../engine/share/modules/tri7box.F
29!||====================================================================
30 SUBROUTINE i25pen3_e2s(JLT ,CAND_S ,CAND_M ,DRAD ,IGAP0 ,
31 . NEDGE ,LEDGE ,MARGE ,GAP_M ,GAP_M_L ,
32 . GAPE ,GAP_E_L ,IGAP ,X ,IRECT ,
33 . PENE ,ADMSR ,EDG_BISECTOR,VTX_BISECTOR,ITAB ,
34 . XREM_EDGE,S1_XREM,S2_XREM,DGAPLOAD)
35
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE tri7box
40C-----------------------------------------------
41C I m p l i c i t T y p e s
42C-----------------------------------------------
43#include "implicit_f.inc"
44C-----------------------------------------------
45C G l o b a l P a r a m e t e r s
46C-----------------------------------------------
47#include "mvsiz_p.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "i25edge_c.inc"
52#include "param_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER, INTENT(IN) :: S1_XREM,S2_XREM
57 my_real, INTENT(IN) :: XREM_EDGE(S1_XREM,S2_XREM)
58 INTEGER JLT, IGAP0, NEDGE, IGAP
59 INTEGER IRECT(4,*), CAND_S(*), CAND_M(*), LEDGE(NLEDGE,*), ADMSR(4,*), ITAB(*)
60 my_real , INTENT(IN) :: dgapload ,drad
61 my_real
62 . marge,
63 . x(3,*), gap_m(*), gap_m_l(*), gape(*), gap_e_l(*), pene(mvsiz)
64 real*4 edg_bisector(3,4,*), vtx_bisector(3,2,*)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I, IG, NI, N1, N2, K, IE, JE, JL, I1, I2, I3, I4, NLS, NLT, LIST(MVSIZ)
69 my_real
70 . XXS1(MVSIZ) ,XXS2(MVSIZ) ,YYS1(MVSIZ) ,YYS2(MVSIZ) ,ZZS1(MVSIZ) ,ZZS2(MVSIZ) ,
71 . XX1,YY1,ZZ1,XX2,YY2,ZZ2,XX3,YY3,ZZ3,XX4,YY4,ZZ4,
72 . xxa,yya,zza,xxb,yyb,zzb,
73 . xmaxs,ymaxs,zmaxs,xmaxm,ymaxm,zmaxm,dx,dy,dz,
74 . xmins,ymins,zmins,xminm,yminm,zminm,gapv(mvsiz),
75 . x1(mvsiz), y1(mvsiz), z1(mvsiz),
76 . x2(mvsiz), y2(mvsiz), z2(mvsiz),
77 . x3(mvsiz), y3(mvsiz), z3(mvsiz),
78 . x4(mvsiz), y4(mvsiz), z4(mvsiz),
79 . x31(mvsiz), y31(mvsiz), z31(mvsiz), x42(mvsiz), y42(mvsiz),
80 . z42(mvsiz), x21(mvsiz), y21(mvsiz), z21(mvsiz),
81 . e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
82 . e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
83 . e3x(mvsiz), e3y(mvsiz), e3z(mvsiz), suma
84C-----------------------------------------------
85CDIR$ NOFUSION
86 DO i=1,jlt
87 ie = cand_m(i)
88 IF(cand_s(i) <= nedge) THEN
89 je = cand_s(i)
90 gapv(i)=gape(je) ! Peut etre considere comme nul pour l instant
91C
92 IF(igap == 3)
93 . gapv(i)=min(gap_m_l(ie)+gap_e_l(je),gapv(i)) ! under-estimated ...
94 ELSE
95 gapv(i)=xrem_edge(e_gap,cand_s(i)-nedge )
96C
97 IF(igap == 3)
98 . gapv(i)=min(gap_m_l(ie)+xrem_edge(e_gapl,cand_s(i)-nedge),gapv(i))
99C verifier si E_GAPL est bien ce qu'on veut ici
100 ENDIF
101 gapv(i)=max(drad,gapv(i)+dgapload)+marge
102 ENDDO
103
104CDIR$ NOFUSION
105 DO i=1,jlt
106 IF(cand_s(i) <= nedge) THEN
107 n1 = ledge(5,cand_s(i))
108 n2 = ledge(6,cand_s(i))
109
110 xxs1(i) = x(1,n1)
111 yys1(i) = x(2,n1)
112 zzs1(i) = x(3,n1)
113 xxs2(i) = x(1,n2)
114 yys2(i) = x(2,n2)
115 zzs2(i) = x(3,n2)
116 ELSE
117 ni = cand_s(i) - nedge
118 xxs1(i) = xrem_edge(e_x1,ni)
119 yys1(i) = xrem_edge(e_y1,ni)
120 zzs1(i) = xrem_edge(e_z1,ni)
121 xxs2(i) = xrem_edge(e_x2,ni)
122 yys2(i) = xrem_edge(e_y2,ni)
123 zzs2(i) = xrem_edge(e_z2,ni)
124 END IF
125 ENDDO
126CDIR$ NOFUSION
127
128 DO i=1,jlt
129 ie = cand_m(i)
130
131 i1 = irect(1,cand_m(i))
132 i2 = irect(2,cand_m(i))
133 i3 = irect(3,cand_m(i))
134 i4 = irect(4,cand_m(i))
135 x1(i) = x(1,i1)
136 y1(i) = x(2,i1)
137 z1(i) = x(3,i1)
138 x2(i) = x(1,i2)
139 y2(i) = x(2,i2)
140 z2(i) = x(3,i2)
141 x3(i) = x(1,i3)
142 y3(i) = x(2,i3)
143 z3(i) = x(3,i3)
144 x4(i) = x(1,i4)
145 y4(i) = x(2,i4)
146 z4(i) = x(3,i4)
147 END DO
148
149 DO i=1,jlt
150 x21(i)=x2(i)-x1(i)
151 y21(i)=y2(i)-y1(i)
152 z21(i)=z2(i)-z1(i)
153 x31(i)=x3(i)-x1(i)
154 y31(i)=y3(i)-y1(i)
155 z31(i)=z3(i)-z1(i)
156 x42(i)=x4(i)-x2(i)
157 y42(i)=y4(i)-y2(i)
158 z42(i)=z4(i)-z2(i)
159C
160 e3x(i)=y31(i)*z42(i)-z31(i)*y42(i)
161 e3y(i)=z31(i)*x42(i)-x31(i)*z42(i)
162 e3z(i)=x31(i)*y42(i)-y31(i)*x42(i)
163 suma=e3x(i)*e3x(i)+e3y(i)*e3y(i)+e3z(i)*e3z(i)
164 suma=max(sqrt(suma),em20)
165 e3x(i)=e3x(i)/suma
166 e3y(i)=e3y(i)/suma
167 e3z(i)=e3z(i)/suma
168 END DO
169C
170 DO i=1,jlt
171 suma= x21(i)*e3x(i)+y21(i)*e3y(i)+z21(i)*e3z(i)
172 e1x(i)= x21(i)-e3x(i)*suma
173 e1y(i)= y21(i)-e3y(i)*suma
174 e1z(i)= z21(i)-e3z(i)*suma
175 ENDDO
176C
177 DO i=1,jlt
178 suma=e1x(i)*e1x(i)+e1y(i)*e1y(i)+e1z(i)*e1z(i)
179 suma=max(sqrt(suma),em20)
180 e1x(i)=e1x(i)/suma
181 e1y(i)=e1y(i)/suma
182 e1z(i)=e1z(i)/suma
183 ENDDO
184C
185 DO i=1,jlt
186 e2x(i)=e3y(i)*e1z(i)-e3z(i)*e1y(i)
187 e2y(i)=e3z(i)*e1x(i)-e3x(i)*e1z(i)
188 e2z(i)=e3x(i)*e1y(i)-e3y(i)*e1x(i)
189 suma =e2x(i)*e2x(i)+e2y(i)*e2y(i)+e2z(i)*e2z(i)
190 suma =max(sqrt(suma),em20)
191 e2x(i)=e2x(i)/suma
192 e2y(i)=e2y(i)/suma
193 e2z(i)=e2z(i)/suma
194 ENDDO
195C
196 nls=0
197CDIR$ NOFUSION
198 DO i=1,jlt
199 xx1=e1x(i)*x1(i)+e1y(i)*y1(i)+e1z(i)*z1(i)
200 xx2=e1x(i)*x2(i)+e1y(i)*y2(i)+e1z(i)*z2(i)
201 xx3=e1x(i)*x3(i)+e1y(i)*y3(i)+e1z(i)*z3(i)
202 xx4=e1x(i)*x4(i)+e1y(i)*y4(i)+e1z(i)*z4(i)
203 xminm=min(xx1,xx2,xx3,xx4)
204 xmaxm=max(xx1,xx2,xx3,xx4)
205 dx=em02*(xmaxm-xminm)
206 xminm=xminm-dx-gapv(i)
207 xmaxm=xmaxm+dx+gapv(i)
208 xxa=e1x(i)*xxs1(i)+e1y(i)*yys1(i)+e1z(i)*zzs1(i)
209 xxb=e1x(i)*xxs2(i)+e1y(i)*yys2(i)+e1z(i)*zzs2(i)
210 xmins = min(xxa,xxb)
211 xmaxs = max(xxa,xxb)
212 IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
213 nls=nls+1
214 list(nls)=i
215 ENDIF
216 ENDDO
217
218 nlt=nls
219 nls=0
220
221CDIR$ NOFUSION
222 DO k=1,nlt
223 i=list(k)
224 yy1=e2x(i)*x1(i)+e2y(i)*y1(i)+e2z(i)*z1(i)
225 yy2=e2x(i)*x2(i)+e2y(i)*y2(i)+e2z(i)*z2(i)
226 yy3=e2x(i)*x3(i)+e2y(i)*y3(i)+e2z(i)*z3(i)
227 yy4=e2x(i)*x4(i)+e2y(i)*y4(i)+e2z(i)*z4(i)
228 yminm=min(yy1,yy2,yy3,yy4)
229 ymaxm=max(yy1,yy2,yy3,yy4)
230 dy=em02*(ymaxm-yminm)
231 yminm=yminm-dy-gapv(i)
232 ymaxm=ymaxm+dy+gapv(i)
233 yya=e2x(i)*xxs1(i)+e2y(i)*yys1(i)+e2z(i)*zzs1(i)
234 yyb=e2x(i)*xxs2(i)+e2y(i)*yys2(i)+e2z(i)*zzs2(i)
235 ymins = min(yya,yyb)
236 ymaxs = max(yya,yyb)
237 IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
238 nls=nls+1
239 list(nls)=i
240 ENDIF
241 ENDDO
242
243 nlt=nls
244 nls=0
245CDIR$ NOFUSION
246 DO k=1,nlt
247 i=list(k)
248 zz1=e3x(i)*x1(i)+e3y(i)*y1(i)+e3z(i)*z1(i)
249 zz2=e3x(i)*x2(i)+e3y(i)*y2(i)+e3z(i)*z2(i)
250 zz3=e3x(i)*x3(i)+e3y(i)*y3(i)+e3z(i)*z3(i)
251 zz4=e3x(i)*x4(i)+e3y(i)*y4(i)+e3z(i)*z4(i)
252 zminm=min(zz1,zz2,zz3,zz4)
253 zmaxm=max(zz1,zz2,zz3,zz4)
254 dz=em02*(zmaxm-zminm)
255 zminm=zminm-dz-gapv(i)
256 zmaxm=zmaxm+dz+gapv(i)
257 zza=e3x(i)*xxs1(i)+e3y(i)*yys1(i)+e3z(i)*zzs1(i)
258 zzb=e3x(i)*xxs2(i)+e3y(i)*yys2(i)+e3z(i)*zzs2(i)
259 zmins = min(zza,zzb)
260 zmaxs = max(zza,zzb)
261 IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
262 nls=nls+1
263 list(nls)=i
264 ENDIF
265 ENDDO
266
267 pene(1:jlt)=zero
268
269 nlt=nls
270C#include "vectorize.inc"
271 DO k=1,nlt
272 i=list(k)
273 pene(i)=one
274 ENDDO
275C
276 RETURN
277 END
i25pen3_e2s
subroutine i25pen3_e2s(jlt, cand_s, cand_m, drad, igap0, nedge, ledge, marge, gap_m, gap_m_l, gape, gap_e_l, igap, x, irect, pene, admsr, edg_bisector, vtx_bisector, itab, xrem_edge, s1_xrem, s2_xrem, dgapload)
Definition i25pen3_e2s.F:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21