OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25pen3_edg.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_edg ../starter/source/interfaces/inter3d1/i25pen3_edg.F
25!||--- called by ------------------------------------------------------
26!|| i25sto_edg ../starter/source/interfaces/inter3d1/i25sto_edg.F
27!||--- uses -----------------------------------------------------
28!|| tri7box ../starter/share/modules1/tri7box.F
29!||====================================================================
30 SUBROUTINE i25pen3_edg(JLT ,CAND_S ,CAND_M ,DRAD ,IGAP0 ,
31 . NEDGE ,LEDGE ,MARGE ,GAPE ,GAP_E_L ,
32 . IGAP ,X ,IRECT ,PENE ,ADMSR ,
33 . EDG_BISECTOR,VTX_BISECTOR,ITAB ,DGAPLOAD)
34
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,*), 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,N1,N2,M1,M2,NI,L,J, IE, JE, IL, JL
66 my_real
67 . XXS1(MVSIZ) ,XXS2(MVSIZ) ,XYS1(MVSIZ) ,XYS2(MVSIZ) ,XZS1(MVSIZ) ,XZS2(MVSIZ) ,
68 . xxm1(mvsiz) ,xxm2(mvsiz) ,xym1(mvsiz) ,xym2(mvsiz) ,xzm1(mvsiz) ,xzm2(mvsiz) ,
69 . xs12,ys12,zs12,xm12,ym12,zm12,xa,xb,
70 . xs2,xm2,xsm,xs2m2,ys2,ym2,ysm,ys2m2,zs2,zm2,zsm,zs2m2,
71 . xx,yy,zz,als,alm,det,gap2,
72 . xmax1,ymax1,zmax1,xmax2,ymax2,zmax2,
73 . xmin1,ymin1,zmin1,xmin2,ymin2,zmin2,gapv(mvsiz),
74 . aaa, dx, dy, dz, dd, ex, ey ,ez, nni, ni2, invcos
75 my_real
76 . maxgapv
77C-----------------------------------------------
78 DO i=1,jlt
79 ie = cand_m(i)
80
81 IF(cand_s(i) <= nedge) THEN
82 je = cand_s(i)
83 gapv(i)=gape(ie)+gape(je)
84C
85 IF(igap0 == 0) THEN
86 gapv(i)=two*gape(ie)+gape(je)
87 ELSE
88 gapv(i)=two*(gape(ie)+gape(je))
89 END IF
90C
91 IF(igap == 3)
92 . gapv(i)=min(gap_e_l(ie)+gap_e_l(je),gapv(i)) ! under-estimated ...
93C
94 gapv(i)= max(drad,gapv(i)+dgapload )+marge
95 ENDIF
96 ENDDO
97
98c MAXGAPV = GAPV(1)
99c DO I = 2,JLT
100c MAXGAPV = MAX(MAXGAPV,GAPV(I))
101c ENDDO
102c WRITE(6,*) __FILE__,__LINE__,"MAXGAPV=",MAXGAPV
103C--------------------------------------------------------
104C
105C--------------------------------------------------------
106C F = [A*X1+(1-A)*X2-B*X3-(1-B)*X4]^2 + [..Y..]^2 + [..Z..]^2
107C DF/DA = 0 = (X1-X2)(A(X1-X2)+X2-X4 +B(X4-X3))+...
108C DF/DA = 0 = A(X1-X2)^2 +X2-X4 + B(X1-X2)(X4-X3))+...
109C DF/DA = 0 = A[(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
110C + B[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
111C + (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
112C DF/DB = 0 = (X4-X3)(A(X1-X2)+X2-X4 +B(X4-X3))+...
113C DF/DB = 0 = B[(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
114C + A[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
115C + (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
116C XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
117C XM2 = [(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
118C XSM = [(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
119C XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
120C XB = (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
121C A XS2 + B XSM + XA = 0
122C A XSM + B XM2 + XB = 0
123C
124C A = -(XA + B XSM)/XS2
125C -(XA + B XSM)*XSM + B XM2*XS2 + XB*XS2 = 0
126C -B XSM*XSM + B XM2*XS2 + XB*XS2-XA*XSM = 0
127C B*(XM2*XS2 - XSM*XSM) = -XB*XS2+XA*XSM
128C B = (XA*XSM-XB*XS2) / (XM2*XS2 - XSM*XSM)
129C A = (XB*XSM-XA*XM2) / (XM2*XS2 - XSM*XSM)
130C--------------------------------------------------------
131 DO i=1,jlt
132 IF(cand_s(i)<=nedge) THEN
133 n1 = ledge(5,cand_s(i))
134 n2 = ledge(6,cand_s(i))
135
136 xxs1(i) = x(1,n1)
137 xys1(i) = x(2,n1)
138 xzs1(i) = x(3,n1)
139 xxs2(i) = x(1,n2)
140 xys2(i) = x(2,n2)
141 xzs2(i) = x(3,n2)
142
143 END IF
144
145 m1 = ledge(5,cand_m(i))
146 m2 = ledge(6,cand_m(i))
147
148 xxm1(i) = x(1,m1)
149 xym1(i) = x(2,m1)
150 xzm1(i) = x(3,m1)
151 xxm2(i) = x(1,m2)
152 xym2(i) = x(2,m2)
153 xzm2(i) = x(3,m2)
154
155 END DO
156C
157C--------------------------------------------------------
158C calcul d'un minorant de la distance
159C--------------------------------------------------------
160 DO i=1,jlt
161 xmax1 = max(xxs1(i),xxs2(i))
162 ymax1 = max(xys1(i),xys2(i))
163 zmax1 = max(xzs1(i),xzs2(i))
164 xmax2 = max(xxm1(i),xxm2(i))
165 ymax2 = max(xym1(i),xym2(i))
166 zmax2 = max(xzm1(i),xzm2(i))
167 xmin1 = min(xxs1(i),xxs2(i))
168 ymin1 = min(xys1(i),xys2(i))
169 zmin1 = min(xzs1(i),xzs2(i))
170 xmin2 = min(xxm1(i),xxm2(i))
171 ymin2 = min(xym1(i),xym2(i))
172 zmin2 = min(xzm1(i),xzm2(i))
173 dd = max(xmin1-xmax2,ymin1-ymax2,zmin1-zmax2,
174 . xmin2-xmax1,ymin2-ymax1,zmin2-zmax1)
175 IF(dd > gapv(i))THEN
176 pene(i) = zero
177 cycle
178 ENDIF
179
180c calcul de la distance^2
181
182 xm12 = xxm2(i)-xxm1(i)
183 ym12 = xym2(i)-xym1(i)
184 zm12 = xzm2(i)-xzm1(i)
185 xm2 = xm12*xm12 + ym12*ym12 + zm12*zm12
186
187 xs12 = xxs2(i)-xxs1(i)
188 ys12 = xys2(i)-xys1(i)
189 zs12 = xzs2(i)-xzs1(i)
190 xs2 = xs12*xs12 + ys12*ys12 + zs12*zs12
191 xsm = - (xs12*xm12 + ys12*ym12 + zs12*zm12)
192 xs2m2 = xxm2(i)-xxs2(i)
193 ys2m2 = xym2(i)-xys2(i)
194 zs2m2 = xzm2(i)-xzs2(i)
195
196 xa = xs12*xs2m2 + ys12*ys2m2 + zs12*zs2m2
197 xb = -xm12*xs2m2 - ym12*ys2m2 - zm12*zs2m2
198 det = xm2*xs2 - xsm*xsm
199 det = max(em20,det)
200C
201 alm = (xa*xsm-xb*xs2) / det
202 xs2 = max(xs2,em20)
203 xm2 = max(xm2,em20)
204 alm=min(one,max(zero,alm))
205 als = -(xa + alm*xsm) / xs2
206 als=min(one,max(zero,als))
207 alm = -(xb + als*xsm) / xm2
208 alm=min(one,max(zero,alm))
209
210C PENE = GAP^2 - DIST^2 UTILISE POUR TESTER SI NON NUL
211
212 xx = als*xxs1(i) + (one-als)*xxs2(i)
213 . - alm*xxm1(i) - (one-alm)*xxm2(i)
214 yy = als*xys1(i) + (one-als)*xys2(i)
215 . - alm*xym1(i) - (one-alm)*xym2(i)
216 zz = als*xzs1(i) + (one-als)*xzs2(i)
217 . - alm*xzm1(i) - (one-alm)*xzm2(i)
218
219 gap2=gapv(i)*gapv(i)
220 pene(i) = max(zero,gap2- xx*xx - yy*yy - zz*zz)
221C
222 END DO
223C
224 RETURN
225 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
i25pen3_edg
subroutine i25pen3_edg(jlt, cand_s, cand_m, drad, igap0, nedge, ledge, marge, gape, gap_e_l, igap, x, irect, pene, admsr, edg_bisector, vtx_bisector, itab, dgapload)
Definition i25pen3_edg.F:34