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