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

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i25pen3_e2s()

subroutine i25pen3_e2s ( integer jlt,
integer, dimension(*) cand_s,
integer, dimension(*) cand_m,
intent(in) drad,
integer igap0,
integer nedge,
integer, dimension(nledge,*) ledge,
marge,
gap_m,
gap_m_l,
gape,
gap_e_l,
integer igap,
x,
integer, dimension(4,*) irect,
pene,
integer, dimension(4,*) admsr,
real*4, dimension(3,4,*) edg_bisector,
real*4, dimension(3,2,*) vtx_bisector,
integer, dimension(*) itab,
dimension(s1_xrem,s2_xrem), intent(in) xrem_edge,
integer, intent(in) s1_xrem,
integer, intent(in) s2_xrem,
intent(in) dgapload )

Definition at line 30 of file i25pen3_e2s.F.

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
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