OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20dst3.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!|| i20dst3 ../engine/source/interfaces/int20/i20dst3.F
25!||--- called by ------------------------------------------------------
26!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
27!||--- calls -----------------------------------------------------
28!|| bitget ../engine/source/interfaces/intsort/i20sto.F
29!|| i20cgap0 ../engine/source/interfaces/int20/i20dst3.F
30!|| i20cgap1 ../engine/source/interfaces/int20/i20dst3.F
31!|| i20cmaj ../engine/source/interfaces/int20/i20curv.F
32!||====================================================================
33 SUBROUTINE i20dst3(
34 1 JLT ,CAND_N ,CAND_E ,CN_LOC ,CE_LOC ,
35 2 X1 ,X2 ,X3 ,X4 ,Y1 ,
36 3 Y2 ,Y3 ,Y4 ,Z1 ,Z2 ,
37 4 Z3 ,Z4 ,XI ,YI ,ZI ,
38 5 NX1 ,NX2 ,NX3 ,NX4 ,NY1 ,
39 6 NY2 ,NY3 ,NY4 ,NZ1 ,NZ2 ,
40 7 NZ3 ,NZ4 ,LB1 ,LB2 ,LB3 ,
41 8 LB4 ,LC1 ,LC2 ,LC3 ,LC4 ,
42 9 P1 ,P2 ,P3 ,P4 ,IX1 ,
43 A IX2 ,IX3 ,IX4 ,NSVG ,STIF ,
44 B JLT_NEW ,GAPV ,INACTI ,SOLIDN_NORMAL,
45 C INDEX ,VXI ,VYI ,GAPR ,GAP_SH ,
46 D VZI ,MSI ,KINI ,ICURV ,IRECT ,
47 E NNX1 ,NNX2 ,NNX3 ,NNX4 ,NNY1 ,
48 F NNY2 ,NNY3 ,NNY4 ,NNZ1 ,NNZ2 ,
49 G NNZ3 ,NNZ4 ,NOD_NORMAL,IADM,RCURVI ,
50 H ANGLMI ,INTTH ,TEMPI ,PHI ,AREASI ,
51 I IELECI ,NLN ,NLG ,IGAP ,GAPMAX ,
52 J SOLIDN_NORMAL_F,NSMS ,NBINFLG,GAP_M ,
53 K CMAJ)
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C G l o b a l P a r a m e t e r s
60C-----------------------------------------------
61#include "mvsiz_p.inc"
62#include "sms_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER JLT, JLT_NEW,INACTI, IGAP,CAND_N(*),CN_LOC(MVSIZ),
67 . CAND_E(*),CE_LOC(MVSIZ), NSVG(MVSIZ), KINI(*)
68 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
69 . INDEX(MVSIZ),INTTH,IELECI(MVSIZ),NLN,NLG(NLN),
70 . NSMS(MVSIZ) ,NBINFLG(*)
71 my_real
72 . NX1(MVSIZ), NX2(MVSIZ), NX3(MVSIZ), NX4(MVSIZ),
73 . NY1(MVSIZ), NY2(MVSIZ), NY3(MVSIZ), NY4(MVSIZ),
74 . NZ1(MVSIZ), NZ2(MVSIZ), NZ3(MVSIZ), NZ4(MVSIZ),
75 . LB1(MVSIZ), LB2(MVSIZ), LB3(MVSIZ), LB4(MVSIZ),
76 . LC1(MVSIZ), LC2(MVSIZ), LC3(MVSIZ), LC4(MVSIZ),
77 . KB1(MVSIZ), KB2(MVSIZ), KB3(MVSIZ), KB4(MVSIZ),
78 . KC1(MVSIZ), KC2(MVSIZ), KC3(MVSIZ), KC4(MVSIZ),
79 . X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),
80 . Y1(MVSIZ), Y2(MVSIZ), Y3(MVSIZ), Y4(MVSIZ),
81 . Z1(MVSIZ), Z2(MVSIZ), Z3(MVSIZ), Z4(MVSIZ),
82 . XI(MVSIZ), YI(MVSIZ), ZI(MVSIZ), STIF(MVSIZ),
83 . P1(MVSIZ), P2(MVSIZ), P3(MVSIZ), P4(MVSIZ),
84 . GAPV(MVSIZ), GAPR(MVSIZ),GAP_SH(*), GAP_M(*),
85 . VXI(MVSIZ), VYI(MVSIZ), VZI(MVSIZ), MSI(MVSIZ),
86 . tempi(mvsiz),phi(mvsiz),areasi(mvsiz),gapmax
87 INTEGER IRECT(4,*),ICURV, IADM
88 INTEGER SOLIDN_NORMAL(3,*), SOLIDN_NORMAL_F(3,*)
89 my_real
90 . NNX1(MVSIZ), NNX2(MVSIZ), NNX3(MVSIZ), NNX4(MVSIZ),
91 . nny1(mvsiz), nny2(mvsiz), nny3(mvsiz), nny4(mvsiz),
92 . nnz1(mvsiz), nnz2(mvsiz), nnz3(mvsiz), nnz4(mvsiz),
93 . nod_normal(3,*)
94 my_real
95 . rcurvi(mvsiz), anglmi(mvsiz),cmaj(mvsiz)
96C-----------------------------------------------
97C L o c a l V a r i a b l e s
98C-----------------------------------------------
99 INTEGER I, IG, J,M,I1,I2,I3,I4,IB1,IB2,IB3,IB4
100 my_real
101 . X0(MVSIZ), Y0(MVSIZ), Z0(MVSIZ),
102 . AL1(MVSIZ), AL2(MVSIZ), AL3(MVSIZ), AL4(MVSIZ),
103 . X01(MVSIZ), X02(MVSIZ), X03(MVSIZ), X04(MVSIZ),
104 . Y01(MVSIZ), Y02(MVSIZ), Y03(MVSIZ), Y04(MVSIZ),
105 . Z01(MVSIZ), Z02(MVSIZ), Z03(MVSIZ), Z04(MVSIZ),
106 . XI1(MVSIZ), XI2(MVSIZ), XI3(MVSIZ), XI4(MVSIZ),
107 . yi1(mvsiz), yi2(mvsiz), yi3(mvsiz), yi4(mvsiz),
108 . zi1(mvsiz), zi2(mvsiz), zi3(mvsiz), zi4(mvsiz),
109 . pene2(mvsiz),
110 . hlb1(mvsiz), hlc1(mvsiz), hlb2(mvsiz),hlc2(mvsiz),
111 . hlb3(mvsiz), hlc3(mvsiz), hlb4(mvsiz),hlc4(mvsiz)
112 my_real
113 . s2,d1,d2,d3,d4,xxx,yyy,zzz,
114 . x12,x23,x34,x41,xi0,sx1,sx2,sx3,sx4,sx0,sxi,
115 . y12,y23,y34,y41,yi0,sy1,sy2,sy3,sy4,sy0,syi,
116 . z12,z23,z34,z41,zi0,sz1,sz2,sz3,sz4,sz0,szi,
117 . x10,y10,z10,x20,y20,z20,x30,y30,z30,x40,y40,z40,
118 . gap2, ds2,t1,t2,t3,
119 . al1num,al2num,al3num,al4num,al1den,al2den,al3den,al4den,
120 . x23d,y23d,z23d,x34d,y34d,z34d,x41d,y41d,z41d, unssqr3,
121 . x12d,y12d,z12d,gap2d,xi0d,yi0d,zi0d,s2d, la, hla, aaa,
122 . xi0v(mvsiz), yi0v(mvsiz), zi0v(mvsiz)
123
124 INTEGER BITUNSET,BITGET,BITSET
125 EXTERNAL BITUNSET,BITGET,BITSET
126C--------------------------------------------------------
127C SHIFT DU GAP POUR SOLIDES AVEC GAP NUL
128C--------------------------------------------------------
129 IF(IGAP /= 0)then
130 unssqr3 = one/sqr3
131 DO i=1,jlt
132 m = cand_e(i)
133 ig = nsvg(i)
134 i1 = nlg(irect(1,m))
135 i2 = nlg(irect(2,m))
136 i3 = nlg(irect(3,m))
137 i4 = nlg(irect(4,m))
138
139 ib1 = bitget(nbinflg(irect(1,m)),7)
140 ib2 = bitget(nbinflg(irect(2,m)),7)
141 ib3 = bitget(nbinflg(irect(3,m)),7)
142 ib4 = bitget(nbinflg(irect(4,m)),7)
143
144 IF(ib1+ib2+ib3+ib4 == 0)THEN
145C elementary normals
146 sx0=(y3(i)-y1(i))*(z4(i)-z2(i))-(z3(i)-z1(i))*(y4(i)-y2(i))
147 sy0=(z3(i)-z1(i))*(x4(i)-x2(i))-(x3(i)-x1(i))*(z4(i)-z2(i))
148 sz0=(x3(i)-x1(i))*(y4(i)-y2(i))-(y3(i)-y1(i))*(x4(i)-x2(i))
149 aaa = one / sqrt(max(em20,sx0*sx0+sy0*sy0+sz0*sz0))
150 sx0=sx0*aaa
151 sy0=sy0*aaa
152 sz0=sz0*aaa
153c second normal substracted from main normal
154c equiv to distribute shift over main and secondary
155 IF(ig > 0) THEN
156 sxi = solidn_normal(1,ig)
157 syi = solidn_normal(2,ig)
158 szi = solidn_normal(3,ig)
159 ELSE
160C remote nodes
161 ig = -ig
162 sxi = solidn_normal_f(1,ig)
163 syi = solidn_normal_f(2,ig)
164 szi = solidn_normal_f(3,ig)
165 END IF
166 aaa = sxi*sx0+syi*sy0+szi*sz0
167 IF(aaa > zero)THEN
168 sxi = zero
169 syi = zero
170 szi = zero
171 ENDIF
172 sx1 = solidn_normal(1,i1)-sxi
173 sy1 = solidn_normal(2,i1)-syi
174 sz1 = solidn_normal(3,i1)-szi
175 aaa = one / sqrt(max(em20,sx1*sx1+sy1*sy1+sz1*sz1))
176 sx1 = sx1*aaa
177 sy1 = sy1*aaa
178 sz1 = sz1*aaa
179 sx2 = solidn_normal(1,i2)-sxi
180 sy2 = solidn_normal(2,i2)-syi
181 sz2 = solidn_normal(3,i2)-szi
182 aaa = one / sqrt(max(em20,sx2*sx2+sy2*sy2+sz2*sz2))
183 sx2 = sx2*aaa
184 sy2 = sy2*aaa
185 sz2 = sz2*aaa
186 sx3 = solidn_normal(1,i3)-sxi
187 sy3 = solidn_normal(2,i3)-syi
188 sz3 = solidn_normal(3,i3)-szi
189 aaa = one / sqrt(max(em20,sx3*sx3+sy3*sy3+sz3*sz3))
190 sx3 = sx3*aaa
191 sy3 = sy3*aaa
192 sz3 = sz3*aaa
193 sx4 = solidn_normal(1,i4)-sxi
194 sy4 = solidn_normal(2,i4)-syi
195 sz4 = solidn_normal(3,i4)-szi
196 aaa = one / sqrt(max(em20,sx4*sx4+sy4*sy4+sz4*sz4))
197 sx4 = sx4*aaa
198 sy4 = sy4*aaa
199 sz4 = sz4*aaa
200c shift nodales
201 aaa = sx0*sx1 + sy0*sy1 + sz0*sz1
202 IF(aaa > unssqr3)THEN
203 aaa = gap_sh(m)/aaa
204 ELSE
205 aaa = unssqr3 - aaa
206 sx1 = sx1 + aaa*sx0
207 sy1 = sy1 + aaa*sy0
208 sz1 = sz1 + aaa*sz0
209 aaa = gap_sh(m)*sqr3
210 ENDIF
211 sx1 = sx1*aaa
212 sy1 = sy1*aaa
213 sz1 = sz1*aaa
214 aaa = sx0*sx2 + sy0*sy2 + sz0*sz2
215 IF(aaa > unssqr3)THEN
216 aaa = gap_sh(m)/aaa
217 ELSE
218 aaa = unssqr3 - aaa
219 sx2 = sx2 + aaa*sx0
220 sy2 = sy2 + aaa*sy0
221 sz2 = sz2 + aaa*sz0
222 aaa = gap_sh(m)*sqr3
223 ENDIF
224 sx2 = sx2*aaa
225 sy2 = sy2*aaa
226 sz2 = sz2*aaa
227 aaa = sx0*sx3 + sy0*sy3 + sz0*sz3
228 IF(aaa > unssqr3)THEN
229 aaa = gap_sh(m)/aaa
230 ELSE
231 aaa = unssqr3 - aaa
232 sx3 = sx3 + aaa*sx0
233 sy3 = sy3 + aaa*sy0
234 sz3 = sz3 + aaa*sz0
235 aaa = gap_sh(m)*sqr3
236 ENDIF
237 sx3 = sx3*aaa
238 sy3 = sy3*aaa
239 sz3 = sz3*aaa
240 aaa = sx0*sx4 + sy0*sy4 + sz0*sz4
241 IF(aaa > unssqr3)THEN
242 aaa = gap_sh(m)/aaa
243 ELSE
244 aaa = unssqr3 - aaa
245 sx4 = sx4 + aaa*sx0
246 sy4 = sy4 + aaa*sy0
247 sz4 = sz4 + aaa*sz0
248 aaa = gap_sh(m)*sqr3
249 ENDIF
250 sx4 = sx4*aaa
251 sy4 = sy4*aaa
252 sz4 = sz4*aaa
253
254 x1(i) = x1(i) - sx1
255 y1(i) = y1(i) - sy1
256 z1(i) = z1(i) - sz1
257 x2(i) = x2(i) - sx2
258 y2(i) = y2(i) - sy2
259 z2(i) = z2(i) - sz2
260 x3(i) = x3(i) - sx3
261 y3(i) = y3(i) - sy3
262 z3(i) = z3(i) - sz3
263 x4(i) = x4(i) - sx4
264 y4(i) = y4(i) - sy4
265 z4(i) = z4(i) - sz4
266
267 ELSEIF(i3 == i4)THEN
268c bord de coque3N
269 x10 = x1(i)
270 y10 = y1(i)
271 z10 = z1(i)
272 x20 = x2(i)
273 y20 = y2(i)
274 z20 = z2(i)
275 x30 = x3(i)
276 y30 = y3(i)
277 z30 = z3(i)
278 IF(ib1 == 1 .and. ib2 == 1)THEN
279 CALL i20cgap0(x10,y10,z10,x20,y20,z20,
280 . x30,y30,z30,x30,y30,z30,
281 . x1(i),y1(i),z1(i),x2(i),y2(i),z2(i),
282 . x3(i),y3(i),z3(i),x3(i),y3(i),z3(i),
283 . gap_m(m))
284 ENDIF
285 IF(ib2 == 1 .and. ib3 == 1)THEN
286 CALL i20cgap0(x20,y20,z20,x30,y30,z30,
287 . x10,y10,z10,x10,y10,z10,
288 . x2(i),y2(i),z2(i),x3(i),y3(i),z3(i),
289 . x1(i),y1(i),z1(i),x1(i),y1(i),z1(i),
290 . gap_m(m))
291 ENDIF
292 IF(ib3 == 1 .and. ib1 == 1)THEN
293 CALL i20cgap0(x30,y30,z30,x10,y10,z10,
294 . x20,y20,z20,x20,y20,z20,
295 . x3(i),y3(i),z3(i),x1(i),y1(i),z1(i),
296 . x2(i),y2(i),z2(i),x2(i),y2(i),z2(i),
297 . gap_m(m))
298 ENDIF
299 IF(ib1 == 1 .and. ib2+ib3 == 0)THEN
300 CALL i20cgap1(x10,y10,z10,x20,y20,z20,
301 . x30,y30,z30,
302 . x1(i),y1(i),z1(i),x2(i),y2(i),z2(i),
303 . x3(i),y3(i),z3(i),gap_m(m))
304 ENDIF
305 IF(ib2 == 1 .and. ib3+ib1 == 0)THEN
306 CALL i20cgap1(x20,y20,z20,x30,y30,z30,
307 . x10,y10,z10,
308 . x2(i),y2(i),z2(i),x3(i),y3(i),z3(i),
309 . x1(i),y1(i),z1(i),gap_m(m))
310 ENDIF
311 IF(ib3 == 1 .and. ib1+ib2 == 0)THEN
312 CALL i20cgap1(x30,y30,z30,x10,y10,z10,
313 . x20,y20,z20,
314 . x3(i),y3(i),z3(i),x1(i),y1(i),z1(i),
315 . x2(i),y2(i),z2(i),gap_m(m))
316 ENDIF
317 x4(i)=x3(i)
318 y4(i)=y3(i)
319 z4(i)=z3(i)
320 ELSE
321c bord de coque
322 x10 = x1(i)
323 y10 = y1(i)
324 z10 = z1(i)
325 x20 = x2(i)
326 y20 = y2(i)
327 z20 = z2(i)
328 x30 = x3(i)
329 y30 = y3(i)
330 z30 = z3(i)
331 x40 = x4(i)
332 y40 = y4(i)
333 z40 = z4(i)
334 IF(ib1 == 1 .and. ib2 == 1)THEN
335 CALL i20cgap0(x10,y10,z10,x20,y20,z20,
336 . x30,y30,z30,x40,y40,z40,
337 . x1(i),y1(i),z1(i),x2(i),y2(i),z2(i),
338 . x3(i),y3(i),z3(i),x4(i),y4(i),z4(i),
339 . gap_m(m))
340 ENDIF
341 IF(ib2 == 1 .and. ib3 == 1)THEN
342 CALL i20cgap0(x20,y20,z20,x30,y30,z30,
343 . x40,y40,z40,x10,y10,z10,
344 . x2(i),y2(i),z2(i),x3(i),y3(i),z3(i),
345 . x4(i),y4(i),z4(i),x1(i),y1(i),z1(i),
346 . gap_m(m))
347 ENDIF
348 IF(ib3 == 1 .and. ib4 == 1)THEN
349 CALL i20cgap0(x30,y30,z30,x40,y40,z40,
350 . x10,y10,z10,x20,y20,z20,
351 . x3(i),y3(i),z3(i),x4(i),y4(i),z4(i),
352 . x1(i),y1(i),z1(i),x2(i),y2(i),z2(i),
353 . gap_m(m))
354 ENDIF
355 IF(ib4 == 1 .and. ib1 == 1)THEN
356 CALL i20cgap0(x40,y40,z40,x10,y10,z10,
357 . x20,y20,z20,x30,y30,z30,
358 . x4(i),y4(i),z4(i),x1(i),y1(i),z1(i),
359 . x2(i),y2(i),z2(i),x3(i),y3(i),z3(i),
360 . gap_m(m))
361 ENDIF
362 IF(ib1 == 1 .and. ib2+ib4 == 0)THEN
363 CALL i20cgap1(x10,y10,z10,x20,y20,z20,
364 . x40,y40,z40,
365 . x1(i),y1(i),z1(i),x2(i),y2(i),z2(i),
366 . x4(i),y4(i),z4(i),gap_m(m))
367 ENDIF
368 IF(ib2 == 1 .and. ib3+ib1 == 0)THEN
369 CALL i20cgap1(x20,y20,z20,x30,y30,z30,
370 . x10,y10,z10,
371 . x2(i),y2(i),z2(i),x3(i),y3(i),z3(i),
372 . x1(i),y1(i),z1(i),gap_m(m))
373 ENDIF
374 IF(ib3 == 1 .and. ib4+ib2 == 0)THEN
375 CALL i20cgap1(x30,y30,z30,x40,y40,z40,
376 . x10,y10,z10,
377 . x3(i),y3(i),z3(i),x4(i),y4(i),z4(i),
378 . x2(i),y2(i),z2(i),gap_m(m))
379 ENDIF
380 IF(ib4 == 1 .and. ib1+ib3 == 0)THEN
381 CALL i20cgap1(x40,y40,z40,x10,y10,z10,
382 . x30,y30,z30,
383 . x4(i),y4(i),z4(i),x1(i),y1(i),z1(i),
384 . x3(i),y3(i),z3(i),gap_m(m))
385 ENDIF
386 ENDIF
387 ENDDO
388 ENDIF
389C--------------------------------------------------------
390C CAS DES PAQUETS MIXTES
391C--------------------------------------------------------
392 DO i=1,jlt
393 IF(ix3(i)/=ix4(i))THEN
394 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
395 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
396 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
397 ELSE
398 x0(i) = x3(i)
399 y0(i) = y3(i)
400 z0(i) = z3(i)
401 ENDIF
402 ENDDO
403C--------------------------------------------------------
404C UNIQUEMENT POUR PAQUET DE TRIANGLE
405C--------------------------------------------------------
406C--------------------------------------------------------
407C CAS DES PAQUETS MIXTES OU QUADRANGLE
408C--------------------------------------------------------
409C
410 DO i=1,jlt
411 cmaj(i) = zero
412C
413 x01(i) = x1(i) - x0(i)
414 y01(i) = y1(i) - y0(i)
415 z01(i) = z1(i) - z0(i)
416C
417 x02(i) = x2(i) - x0(i)
418 y02(i) = y2(i) - y0(i)
419 z02(i) = z2(i) - z0(i)
420C
421 x03(i) = x3(i) - x0(i)
422 y03(i) = y3(i) - y0(i)
423 z03(i) = z3(i) - z0(i)
424C
425 x04(i) = x4(i) - x0(i)
426 y04(i) = y4(i) - y0(i)
427 z04(i) = z4(i) - z0(i)
428C
429 xi0v(i) = x0(i) - xi(i)
430 yi0v(i) = y0(i) - yi(i)
431 zi0v(i) = z0(i) - zi(i)
432C
433 xi1(i) = x1(i) - xi(i)
434 yi1(i) = y1(i) - yi(i)
435 zi1(i) = z1(i) - zi(i)
436C
437 xi2(i) = x2(i) - xi(i)
438 yi2(i) = y2(i) - yi(i)
439 zi2(i) = z2(i) - zi(i)
440C
441 xi3(i) = x3(i) - xi(i)
442 yi3(i) = y3(i) - yi(i)
443 zi3(i) = z3(i) - zi(i)
444C
445 xi4(i) = x4(i) - xi(i)
446 yi4(i) = y4(i) - yi(i)
447 zi4(i) = z4(i) - zi(i)
448C
449 sx1 = yi0v(i)*zi1(i) - zi0v(i)*yi1(i)
450 sy1 = zi0v(i)*xi1(i) - xi0v(i)*zi1(i)
451 sz1 = xi0v(i)*yi1(i) - yi0v(i)*xi1(i)
452C
453 sx2 = yi0v(i)*zi2(i) - zi0v(i)*yi2(i)
454 sy2 = zi0v(i)*xi2(i) - xi0v(i)*zi2(i)
455 sz2 = xi0v(i)*yi2(i) - yi0v(i)*xi2(i)
456C
457 sx0 = y01(i)*z02(i) - z01(i)*y02(i)
458 sy0 = z01(i)*x02(i) - x01(i)*z02(i)
459 sz0 = x01(i)*y02(i) - y01(i)*x02(i)
460 s2 = 1./max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
461C
462 lb1(i) = -(sx0*sx2 + sy0*sy2 + sz0*sz2) * s2
463 lc1(i) = (sx0*sx1 + sy0*sy1 + sz0*sz1) * s2
464C
465 sx3 = yi0v(i)*zi3(i) - zi0v(i)*yi3(i)
466 sy3 = zi0v(i)*xi3(i) - xi0v(i)*zi3(i)
467 sz3 = xi0v(i)*yi3(i) - yi0v(i)*xi3(i)
468C
469 sx0 = y02(i)*z03(i) - z02(i)*y03(i)
470 sy0 = z02(i)*x03(i) - x02(i)*z03(i)
471 sz0 = x02(i)*y03(i) - y02(i)*x03(i)
472 s2 = 1./max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
473C
474 lb2(i) = -(sx0*sx3 + sy0*sy3 + sz0*sz3) * s2
475 lc2(i) = (sx0*sx2 + sy0*sy2 + sz0*sz2) * s2
476C
477 sx4 = yi0v(i)*zi4(i) - zi0v(i)*yi4(i)
478 sy4 = zi0v(i)*xi4(i) - xi0v(i)*zi4(i)
479 sz4 = xi0v(i)*yi4(i) - yi0v(i)*xi4(i)
480C
481 sx0 = y03(i)*z04(i) - z03(i)*y04(i)
482 sy0 = z03(i)*x04(i) - x03(i)*z04(i)
483 sz0 = x03(i)*y04(i) - y03(i)*x04(i)
484 s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
485C
486 lb3(i) = -(sx0*sx4 + sy0*sy4 + sz0*sz4) * s2
487 lc3(i) = (sx0*sx3 + sy0*sy3 + sz0*sz3) * s2
488C
489 sx0 = y04(i)*z01(i) - z04(i)*y01(i)
490 sy0 = z04(i)*x01(i) - x04(i)*z01(i)
491 sz0 = x04(i)*y01(i) - y04(i)*x01(i)
492 s2 = one/max(em30,sx0*sx0 + sy0*sy0 + sz0*sz0)
493C
494 lb4(i) = -(sx0*sx1 + sy0*sy1 + sz0*sz1) * s2
495 lc4(i) = (sx0*sx4 + sy0*sy4 + sz0*sz4) * s2
496C
497 ENDDO
498 DO i=1,jlt
499 aaa = one/max(em30,x01(i)*x01(i)+y01(i)*y01(i)+z01(i)*z01(i))
500 hlc1(i)= lc1(i)*abs(lc1(i))*aaa
501 hlb4(i)= lb4(i)*abs(lb4(i))*aaa
502 al1(i) = -(xi0v(i)*x01(i)+yi0v(i)*y01(i)+zi0v(i)*z01(i))*aaa
503 al1(i) = max(zero,min(one,al1(i)))
504 aaa = one/max(em30,x02(i)*x02(i)+y02(i)*y02(i)+z02(i)*z02(i))
505 hlc2(i)= lc2(i)*abs(lc2(i))*aaa
506 hlb1(i)= lb1(i)*abs(lb1(i))*aaa
507 al2(i) = -(xi0v(i)*x02(i)+yi0v(i)*y02(i)+zi0v(i)*z02(i))*aaa
508 al2(i) = max(zero,min(one,al2(i)))
509 aaa = one/max(em30,x03(i)*x03(i)+y03(i)*y03(i)+z03(i)*z03(i))
510 hlc3(i)= lc3(i)*abs(lc3(i))*aaa
511 hlb2(i)= lb2(i)*abs(lb2(i))*aaa
512 al3(i) = -(xi0v(i)*x03(i)+yi0v(i)*y03(i)+zi0v(i)*z03(i))*aaa
513 al3(i) = max(zero,min(one,al3(i)))
514 aaa = one/max(em30,x04(i)*x04(i)+y04(i)*y04(i)+z04(i)*z04(i))
515 hlc4(i)= lc4(i)*abs(lc4(i))*aaa
516 hlb3(i)= lb3(i)*abs(lb3(i))*aaa
517 al4(i) = -(xi0v(i)*x04(i)+yi0v(i)*y04(i)+zi0v(i)*z04(i))*aaa
518 al4(i) = max(zero,min(one,al4(i)))
519C
520 ENDDO
521C
522C
523 DO i=1,jlt
524 x12 = x2(i) - x1(i)
525 y12 = y2(i) - y1(i)
526 z12 = z2(i) - z1(i)
527 la = one - lb1(i) - lc1(i)
528C HLA, HLB1, HLC1 necessaires pour triangle angle obtu
529 aaa = one / max(em20,x12*x12+y12*y12+z12*z12)
530 hla= la*abs(la) * aaa
531 IF(la<zero.AND.
532 + hla<=hlb1(i).AND.hla<=hlc1(i))THEN
533 lb1(i) = (xi2(i)*x12+yi2(i)*y12+zi2(i)*z12) * aaa
534 lb1(i) = max(zero,min(one,lb1(i)))
535 lc1(i) = one - lb1(i)
536 ELSEIF(lb1(i)<zero.AND.
537 + hlb1(i)<=hlc1(i).AND.hlb1(i)<=hla)THEN
538 lb1(i) = zero
539 lc1(i) = al2(i)
540 ELSEIF(lc1(i)<zero.AND.
541 + hlc1(i)<=hla.AND.hlc1(i)<=hlb1(i))THEN
542 lc1(i) = zero
543 lb1(i) = al1(i)
544 ENDIF
545 ENDDO
546C
547 DO i=1,jlt
548 x23 = x3(i) - x2(i)
549 y23 = y3(i) - y2(i)
550 z23 = z3(i) - z2(i)
551 la = one - lb2(i) - lc2(i)
552C HLA, HLB1, HLC1 necessaires pour triangle angle obtu
553 aaa = one / max(em20,x23*x23+y23*y23+z23*z23)
554 hla= la*abs(la) * aaa
555 IF(la<zero.AND.
556 + hla<=hlb2(i).AND.hla<=hlc2(i))THEN
557 lb2(i) = (xi3(i)*x23+yi3(i)*y23+zi3(i)*z23)*aaa
558 lb2(i) = max(zero,min(one,lb2(i)))
559 lc2(i) = one - lb2(i)
560 ELSEIF(lb2(i)<zero.AND.
561 + hlb2(i)<=hlc2(i).AND.hlb2(i)<=hla)THEN
562 lb2(i) = zero
563 lc2(i) = al3(i)
564 ELSEIF(lc2(i)<zero.AND.
565 + hlc2(i)<=hla.AND.hlc2(i)<=hlb2(i))THEN
566 lc2(i) = zero
567 lb2(i) = al2(i)
568 ENDIF
569 ENDDO
570C
571 DO i=1,jlt
572 x34 = x4(i) - x3(i)
573 y34 = y4(i) - y3(i)
574 z34 = z4(i) - z3(i)
575 la = one - lb3(i) - lc3(i)
576C HLA, HLB1, HLC1 necessaires pour triangle angle obtu
577 aaa = one / max(em20,x34*x34+y34*y34+z34*z34)
578 hla= la*abs(la) * aaa
579 IF(la<zero.AND.
580 + hla<=hlb3(i).AND.hla<=hlc3(i))THEN
581 lb3(i) = (xi4(i)*x34+yi4(i)*y34+zi4(i)*z34)*aaa
582 lb3(i) = max(zero,min(one,lb3(i)))
583 lc3(i) = one - lb3(i)
584 ELSEIF(lb3(i)<zero.AND.
585 + hlb3(i)<=hlc3(i).AND.hlb3(i)<=hla)THEN
586 lb3(i) = zero
587 lc3(i) = al4(i)
588 ELSEIF(lc3(i)<zero.AND.
589 + hlc3(i)<=hla.AND.hlc3(i)<=hlb3(i))THEN
590 lc3(i) = zero
591 lb3(i) = al3(i)
592 ENDIF
593 ENDDO
594C
595 DO i=1,jlt
596 x41 = x1(i) - x4(i)
597 y41 = y1(i) - y4(i)
598 z41 = z1(i) - z4(i)
599 la = one - lb4(i) - lc4(i)
600C HLA, HLB1, HLC1 necessaires pour triangle angle obtu
601 aaa = one / max(em20,x41*x41+y41*y41+z41*z41)
602 hla= la*abs(la) * aaa
603 IF(la<zero.AND.
604 + hla<=hlb4(i).AND.hla<=hlc4(i))THEN
605 lb4(i) = (xi1(i)*x41+yi1(i)*y41+zi1(i)*z41)*aaa
606 lb4(i) = max(zero,min(one,lb4(i)))
607 lc4(i) = one - lb4(i)
608 ELSEIF(lb4(i)<zero.AND.
609 + hlb4(i)<=hlc4(i).AND.hlb4(i)<=hla)THEN
610 lb4(i) = zero
611 lc4(i) = al1(i)
612 ELSEIF(lc4(i)<zero.AND.
613 + hlc4(i)<=hla.AND.hlc4(i)<=hlb4(i))THEN
614 lc4(i) = zero
615 lb4(i) = al4(i)
616 ENDIF
617 ENDDO
618c---------------------------------------------------------
619c courbure cubique
620c---------------------------------------------------------
621 IF(icurv == 3)THEN
622 CALL i20cmaj(jlt ,cmaj ,irect ,nod_normal,cand_e,
623 2 x1 ,x2 ,x3 ,x4 ,nln ,
624 3 y1 ,y2 ,y3 ,y4 ,nlg ,
625 4 z1 ,z2 ,z3 ,z4 ,
626 5 nnx1 ,nnx2 ,nnx3 ,nnx4 ,
627 6 nny1 ,nny2 ,nny3 ,nny4 ,
628 7 nnz1 ,nnz2 ,nnz3 ,nnz4 )
629 ELSEIF(icurv /= 0)THEN
630 DO i=1,jlt
631 xxx=max(x1(i),x2(i),x3(i),x4(i))
632 . -min(x1(i),x2(i),x3(i),x4(i))
633 yyy=max(y1(i),y2(i),y3(i),y4(i))
634 . -min(y1(i),y2(i),y3(i),y4(i))
635 zzz=max(z1(i),z2(i),z3(i),z4(i))
636 . -min(z1(i),z2(i),z3(i),z4(i))
637 cmaj(i) = half * max(xxx,yyy,zzz)
638 ENDDO
639 ENDIF
640c
641 DO i=1,jlt
642 gap2=(gapv(i)+cmaj(i))*(gapv(i)+cmaj(i))
643C
644 nx1(i) = xi(i)-(x0(i) + lb1(i)*x01(i) + lc1(i)*x02(i))
645 ny1(i) = yi(i)-(y0(i) + lb1(i)*y01(i) + lc1(i)*y02(i))
646 nz1(i) = zi(i)-(z0(i) + lb1(i)*z01(i) + lc1(i)*z02(i))
647 p1(i) = nx1(i)*nx1(i) + ny1(i)*ny1(i) +nz1(i)*nz1(i)
648 d1 = max(zero, gap2 - p1(i))
649C
650 nx2(i) = xi(i)-(x0(i) + lb2(i)*x02(i) + lc2(i)*x03(i))
651 ny2(i) = yi(i)-(y0(i) + lb2(i)*y02(i) + lc2(i)*y03(i))
652 nz2(i) = zi(i)-(z0(i) + lb2(i)*z02(i) + lc2(i)*z03(i))
653 p2(i) = nx2(i)*nx2(i) + ny2(i)*ny2(i) +nz2(i)*nz2(i)
654 d2 = max(zero, gap2 - p2(i))
655C
656 nx3(i) = xi(i)-(x0(i) + lb3(i)*x03(i) + lc3(i)*x04(i))
657 ny3(i) = yi(i)-(y0(i) + lb3(i)*y03(i) + lc3(i)*y04(i))
658 nz3(i) = zi(i)-(z0(i) + lb3(i)*z03(i) + lc3(i)*z04(i))
659 p3(i) = nx3(i)*nx3(i) + ny3(i)*ny3(i) +nz3(i)*nz3(i)
660 d3 = max(zero, gap2 - p3(i))
661C
662 nx4(i) = xi(i)-(x0(i) + lb4(i)*x04(i) + lc4(i)*x01(i))
663 ny4(i) = yi(i)-(y0(i) + lb4(i)*y04(i) + lc4(i)*y01(i))
664 nz4(i) = zi(i)-(z0(i) + lb4(i)*z04(i) + lc4(i)*z01(i))
665 p4(i) = nx4(i)*nx4(i) + ny4(i)*ny4(i) +nz4(i)*nz4(i)
666 d4 = max(zero, gap2 - p4(i))
667C !!!!!!!!!!!!!!!!!!!!!!!
668C PENE2 = GAP^2 - DIST^2 UTILISE POUR TESTER SI NON NUL
669C!!!!!!!!!!!!!!!!!!!!!!!!
670 pene2(i) = max(d1,d2,d3,d4)
671C
672 ENDDO
673C---------------------
674C PENE INITIALE
675C---------------------
676c IF(INACTI==5.OR.INACTI==6)THEN
677c DO I=1,JLT
678c IF(PENE2(I)==ZERO.OR.STIF(I)==ZERO)THEN
679c CAND_P(INDEX(I))=0
680c ENDIF
681c ENDDO
682c ENDIF
683C
684 IF(idtmins/=2)THEN
685 IF(intth == 0 ) THEN
686 IF(icurv==0.AND.iadm==0 )THEN
687 DO i=1,jlt
688 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
689 jlt_new = jlt_new + 1
690 cn_loc(jlt_new) = cand_n(i)
691 ce_loc(jlt_new) = cand_e(i)
692 ix1(jlt_new) = ix1(i)
693 ix2(jlt_new) = ix2(i)
694 ix3(jlt_new) = ix3(i)
695 ix4(jlt_new) = ix4(i)
696 nsvg(jlt_new) = nsvg(i)
697 nx1(jlt_new) = nx1(i)
698 nx2(jlt_new) = nx2(i)
699 nx3(jlt_new) = nx3(i)
700 nx4(jlt_new) = nx4(i)
701 ny1(jlt_new) = ny1(i)
702 ny2(jlt_new) = ny2(i)
703 ny3(jlt_new) = ny3(i)
704 ny4(jlt_new) = ny4(i)
705 nz1(jlt_new) = nz1(i)
706 nz2(jlt_new) = nz2(i)
707 nz3(jlt_new) = nz3(i)
708 nz4(jlt_new) = nz4(i)
709 p1(jlt_new) = p1(i)
710 p2(jlt_new) = p2(i)
711 p3(jlt_new) = p3(i)
712 p4(jlt_new) = p4(i)
713 lb1(jlt_new) = lb1(i)
714 lb2(jlt_new) = lb2(i)
715 lb3(jlt_new) = lb3(i)
716 lb4(jlt_new) = lb4(i)
717 lc1(jlt_new) = lc1(i)
718 lc2(jlt_new) = lc2(i)
719 lc3(jlt_new) = lc3(i)
720 lc4(jlt_new) = lc4(i)
721 stif(jlt_new) = stif(i)
722 gapv(jlt_new) = gapv(i)
723 gapr(jlt_new) = gapr(i)
724 index(jlt_new)= index(i)
725C
726 kini(jlt_new) = kini(i)
727 vxi(jlt_new) = vxi(i)
728 vyi(jlt_new) = vyi(i)
729 vzi(jlt_new) = vzi(i)
730 msi(jlt_new) = msi(i)
731C
732 ENDIF
733 ENDDO
734 ELSE !
735 DO i=1,jlt
736 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
737 jlt_new = jlt_new + 1
738 cn_loc(jlt_new) = cand_n(i)
739 ce_loc(jlt_new) = cand_e(i)
740 ix1(jlt_new) = ix1(i)
741 ix2(jlt_new) = ix2(i)
742 ix3(jlt_new) = ix3(i)
743 ix4(jlt_new) = ix4(i)
744 nsvg(jlt_new) = nsvg(i)
745 nx1(jlt_new) = nx1(i)
746 nx2(jlt_new) = nx2(i)
747 nx3(jlt_new) = nx3(i)
748 nx4(jlt_new) = nx4(i)
749 ny1(jlt_new) = ny1(i)
750 ny2(jlt_new) = ny2(i)
751 ny3(jlt_new) = ny3(i)
752 ny4(jlt_new) = ny4(i)
753 nz1(jlt_new) = nz1(i)
754 nz2(jlt_new) = nz2(i)
755 nz3(jlt_new) = nz3(i)
756 nz4(jlt_new) = nz4(i)
757 p1(jlt_new) = p1(i)
758 p2(jlt_new) = p2(i)
759 p3(jlt_new) = p3(i)
760 p4(jlt_new) = p4(i)
761 lb1(jlt_new) = lb1(i)
762 lb2(jlt_new) = lb2(i)
763 lb3(jlt_new) = lb3(i)
764 lb4(jlt_new) = lb4(i)
765 lc1(jlt_new) = lc1(i)
766 lc2(jlt_new) = lc2(i)
767 lc3(jlt_new) = lc3(i)
768 lc4(jlt_new) = lc4(i)
769 stif(jlt_new) = stif(i)
770 gapv(jlt_new) = gapv(i)
771 gapr(jlt_new) = gapr(i)
772 index(jlt_new)= index(i)
773 kini(jlt_new) = kini(i)
774 vxi(jlt_new) = vxi(i)
775 vyi(jlt_new) = vyi(i)
776 vzi(jlt_new) = vzi(i)
777 msi(jlt_new) = msi(i)
778C
779 xi(jlt_new) = xi(i)
780 yi(jlt_new) = yi(i)
781 zi(jlt_new) = zi(i)
782 x1(jlt_new) = x1(i)
783 y1(jlt_new) = y1(i)
784 z1(jlt_new) = z1(i)
785 x2(jlt_new) = x2(i)
786 y2(jlt_new) = y2(i)
787 z2(jlt_new) = z2(i)
788 x3(jlt_new) = x3(i)
789 y3(jlt_new) = y3(i)
790 z3(jlt_new) = z3(i)
791 x4(jlt_new) = x4(i)
792 y4(jlt_new) = y4(i)
793 z4(jlt_new) = z4(i)
794 rcurvi(jlt_new) = rcurvi(i)
795 anglmi(jlt_new) = anglmi(i)
796 ENDIF
797 ENDDO
798 ENDIF
799 ELSE
800 IF(iadm == 0 )THEN
801 DO i=1,jlt
802 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
803 jlt_new = jlt_new + 1
804 cn_loc(jlt_new) = cand_n(i)
805 ce_loc(jlt_new) = cand_e(i)
806 ix1(jlt_new) = ix1(i)
807 ix2(jlt_new) = ix2(i)
808 ix3(jlt_new) = ix3(i)
809 ix4(jlt_new) = ix4(i)
810 nsvg(jlt_new) = nsvg(i)
811 nx1(jlt_new) = nx1(i)
812 nx2(jlt_new) = nx2(i)
813 nx3(jlt_new) = nx3(i)
814 nx4(jlt_new) = nx4(i)
815 ny1(jlt_new) = ny1(i)
816 ny2(jlt_new) = ny2(i)
817 ny3(jlt_new) = ny3(i)
818 ny4(jlt_new) = ny4(i)
819 nz1(jlt_new) = nz1(i)
820 nz2(jlt_new) = nz2(i)
821 nz3(jlt_new) = nz3(i)
822 nz4(jlt_new) = nz4(i)
823 p1(jlt_new) = p1(i)
824 p2(jlt_new) = p2(i)
825 p3(jlt_new) = p3(i)
826 p4(jlt_new) = p4(i)
827 lb1(jlt_new) = lb1(i)
828 lb2(jlt_new) = lb2(i)
829 lb3(jlt_new) = lb3(i)
830 lb4(jlt_new) = lb4(i)
831 lc1(jlt_new) = lc1(i)
832 lc2(jlt_new) = lc2(i)
833 lc3(jlt_new) = lc3(i)
834 lc4(jlt_new) = lc4(i)
835 stif(jlt_new) = stif(i)
836 gapv(jlt_new) = gapv(i)
837 gapr(jlt_new) = gapr(i)
838 index(jlt_new)= index(i)
839C
840 kini(jlt_new) = kini(i)
841 vxi(jlt_new) = vxi(i)
842 vyi(jlt_new) = vyi(i)
843 vzi(jlt_new) = vzi(i)
844 msi(jlt_new) = msi(i)
845C
846 xi(jlt_new) = xi(i)
847 yi(jlt_new) = yi(i)
848 zi(jlt_new) = zi(i)
849 x1(jlt_new) = x1(i)
850 y1(jlt_new) = y1(i)
851 z1(jlt_new) = z1(i)
852 x2(jlt_new) = x2(i)
853 y2(jlt_new) = y2(i)
854 z2(jlt_new) = z2(i)
855 x3(jlt_new) = x3(i)
856 y3(jlt_new) = y3(i)
857 z3(jlt_new) = z3(i)
858 x4(jlt_new) = x4(i)
859 y4(jlt_new) = y4(i)
860 z4(jlt_new) = z4(i)
861C
862 tempi(jlt_new) = tempi(i)
863 phi(jlt_new) = zero
864 areasi(jlt_new) = areasi(i)
865 ieleci(jlt_new) =ieleci(i)
866C
867 ENDIF
868 ENDDO
869 ELSE !
870 DO i=1,jlt
871 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
872 jlt_new = jlt_new + 1
873 cn_loc(jlt_new) = cand_n(i)
874 ce_loc(jlt_new) = cand_e(i)
875 ix1(jlt_new) = ix1(i)
876 ix2(jlt_new) = ix2(i)
877 ix3(jlt_new) = ix3(i)
878 ix4(jlt_new) = ix4(i)
879 nsvg(jlt_new) = nsvg(i)
880 nx1(jlt_new) = nx1(i)
881 nx2(jlt_new) = nx2(i)
882 nx3(jlt_new) = nx3(i)
883 nx4(jlt_new) = nx4(i)
884 ny1(jlt_new) = ny1(i)
885 ny2(jlt_new) = ny2(i)
886 ny3(jlt_new) = ny3(i)
887 ny4(jlt_new) = ny4(i)
888 nz1(jlt_new) = nz1(i)
889 nz2(jlt_new) = nz2(i)
890 nz3(jlt_new) = nz3(i)
891 nz4(jlt_new) = nz4(i)
892 p1(jlt_new) = p1(i)
893 p2(jlt_new) = p2(i)
894 p3(jlt_new) = p3(i)
895 p4(jlt_new) = p4(i)
896 lb1(jlt_new) = lb1(i)
897 lb2(jlt_new) = lb2(i)
898 lb3(jlt_new) = lb3(i)
899 lb4(jlt_new) = lb4(i)
900 lc1(jlt_new) = lc1(i)
901 lc2(jlt_new) = lc2(i)
902 lc3(jlt_new) = lc3(i)
903 lc4(jlt_new) = lc4(i)
904 stif(jlt_new) = stif(i)
905 gapv(jlt_new) = gapv(i)
906 gapr(jlt_new) = gapr(i)
907 index(jlt_new)= index(i)
908 kini(jlt_new) = kini(i)
909 vxi(jlt_new) = vxi(i)
910 vyi(jlt_new) = vyi(i)
911 vzi(jlt_new) = vzi(i)
912 msi(jlt_new) = msi(i)
913 xi(jlt_new) = xi(i)
914 yi(jlt_new) = yi(i)
915 zi(jlt_new) = zi(i)
916 x1(jlt_new) = x1(i)
917 y1(jlt_new) = y1(i)
918 z1(jlt_new) = z1(i)
919 x2(jlt_new) = x2(i)
920 y2(jlt_new) = y2(i)
921 z2(jlt_new) = z2(i)
922 x3(jlt_new) = x3(i)
923 y3(jlt_new) = y3(i)
924 z3(jlt_new) = z3(i)
925 x4(jlt_new) = x4(i)
926 y4(jlt_new) = y4(i)
927 z4(jlt_new) = z4(i)
928 rcurvi(jlt_new) = rcurvi(i)
929 anglmi(jlt_new) = anglmi(i)
930 tempi(jlt_new) = tempi(i)
931 phi(jlt_new) = zero
932 areasi(jlt_new) = areasi(i)
933 ieleci(jlt_new) =ieleci(i)
934 ENDIF
935 ENDDO
936 ENDIF
937 ENDIF
938 ELSE
939C------ IDTMINS=2
940 IF(intth == 0 ) THEN
941 IF(icurv==0.AND.iadm==0 )THEN
942 DO i=1,jlt
943 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
944 jlt_new = jlt_new + 1
945 cn_loc(jlt_new) = cand_n(i)
946 ce_loc(jlt_new) = cand_e(i)
947 ix1(jlt_new) = ix1(i)
948 ix2(jlt_new) = ix2(i)
949 ix3(jlt_new) = ix3(i)
950 ix4(jlt_new) = ix4(i)
951 nsvg(jlt_new) = nsvg(i)
952 nx1(jlt_new) = nx1(i)
953 nx2(jlt_new) = nx2(i)
954 nx3(jlt_new) = nx3(i)
955 nx4(jlt_new) = nx4(i)
956 ny1(jlt_new) = ny1(i)
957 ny2(jlt_new) = ny2(i)
958 ny3(jlt_new) = ny3(i)
959 ny4(jlt_new) = ny4(i)
960 nz1(jlt_new) = nz1(i)
961 nz2(jlt_new) = nz2(i)
962 nz3(jlt_new) = nz3(i)
963 nz4(jlt_new) = nz4(i)
964 p1(jlt_new) = p1(i)
965 p2(jlt_new) = p2(i)
966 p3(jlt_new) = p3(i)
967 p4(jlt_new) = p4(i)
968 lb1(jlt_new) = lb1(i)
969 lb2(jlt_new) = lb2(i)
970 lb3(jlt_new) = lb3(i)
971 lb4(jlt_new) = lb4(i)
972 lc1(jlt_new) = lc1(i)
973 lc2(jlt_new) = lc2(i)
974 lc3(jlt_new) = lc3(i)
975 lc4(jlt_new) = lc4(i)
976 stif(jlt_new) = stif(i)
977 gapv(jlt_new) = gapv(i)
978 gapr(jlt_new) = gapr(i)
979 index(jlt_new)= index(i)
980C
981 kini(jlt_new) = kini(i)
982 vxi(jlt_new) = vxi(i)
983 vyi(jlt_new) = vyi(i)
984 vzi(jlt_new) = vzi(i)
985 msi(jlt_new) = msi(i)
986C
987 nsms(jlt_new) = nsms(i)
988C
989 ENDIF
990 ENDDO
991 ELSE !
992 DO i=1,jlt
993 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
994 jlt_new = jlt_new + 1
995 cn_loc(jlt_new) = cand_n(i)
996 ce_loc(jlt_new) = cand_e(i)
997 ix1(jlt_new) = ix1(i)
998 ix2(jlt_new) = ix2(i)
999 ix3(jlt_new) = ix3(i)
1000 ix4(jlt_new) = ix4(i)
1001 nsvg(jlt_new) = nsvg(i)
1002 nx1(jlt_new) = nx1(i)
1003 nx2(jlt_new) = nx2(i)
1004 nx3(jlt_new) = nx3(i)
1005 nx4(jlt_new) = nx4(i)
1006 ny1(jlt_new) = ny1(i)
1007 ny2(jlt_new) = ny2(i)
1008 ny3(jlt_new) = ny3(i)
1009 ny4(jlt_new) = ny4(i)
1010 nz1(jlt_new) = nz1(i)
1011 nz2(jlt_new) = nz2(i)
1012 nz3(jlt_new) = nz3(i)
1013 nz4(jlt_new) = nz4(i)
1014 p1(jlt_new) = p1(i)
1015 p2(jlt_new) = p2(i)
1016 p3(jlt_new) = p3(i)
1017 p4(jlt_new) = p4(i)
1018 lb1(jlt_new) = lb1(i)
1019 lb2(jlt_new) = lb2(i)
1020 lb3(jlt_new) = lb3(i)
1021 lb4(jlt_new) = lb4(i)
1022 lc1(jlt_new) = lc1(i)
1023 lc2(jlt_new) = lc2(i)
1024 lc3(jlt_new) = lc3(i)
1025 lc4(jlt_new) = lc4(i)
1026 stif(jlt_new) = stif(i)
1027 gapv(jlt_new) = gapv(i)
1028 gapr(jlt_new) = gapr(i)
1029 index(jlt_new)= index(i)
1030 kini(jlt_new) = kini(i)
1031 vxi(jlt_new) = vxi(i)
1032 vyi(jlt_new) = vyi(i)
1033 vzi(jlt_new) = vzi(i)
1034 msi(jlt_new) = msi(i)
1035C
1036 xi(jlt_new) = xi(i)
1037 yi(jlt_new) = yi(i)
1038 zi(jlt_new) = zi(i)
1039 x1(jlt_new) = x1(i)
1040 y1(jlt_new) = y1(i)
1041 z1(jlt_new) = z1(i)
1042 x2(jlt_new) = x2(i)
1043 y2(jlt_new) = y2(i)
1044 z2(jlt_new) = z2(i)
1045 x3(jlt_new) = x3(i)
1046 y3(jlt_new) = y3(i)
1047 z3(jlt_new) = z3(i)
1048 x4(jlt_new) = x4(i)
1049 y4(jlt_new) = y4(i)
1050 z4(jlt_new) = z4(i)
1051 rcurvi(jlt_new) = rcurvi(i)
1052 anglmi(jlt_new) = anglmi(i)
1053C
1054 nsms(jlt_new) = nsms(i)
1055 ENDIF
1056 ENDDO
1057 ENDIF
1058 ELSE
1059 IF(iadm == 0 )THEN
1060 DO i=1,jlt
1061 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
1062 jlt_new = jlt_new + 1
1063 cn_loc(jlt_new) = cand_n(i)
1064 ce_loc(jlt_new) = cand_e(i)
1065 ix1(jlt_new) = ix1(i)
1066 ix2(jlt_new) = ix2(i)
1067 ix3(jlt_new) = ix3(i)
1068 ix4(jlt_new) = ix4(i)
1069 nsvg(jlt_new) = nsvg(i)
1070 nx1(jlt_new) = nx1(i)
1071 nx2(jlt_new) = nx2(i)
1072 nx3(jlt_new) = nx3(i)
1073 nx4(jlt_new) = nx4(i)
1074 ny1(jlt_new) = ny1(i)
1075 ny2(jlt_new) = ny2(i)
1076 ny3(jlt_new) = ny3(i)
1077 ny4(jlt_new) = ny4(i)
1078 nz1(jlt_new) = nz1(i)
1079 nz2(jlt_new) = nz2(i)
1080 nz3(jlt_new) = nz3(i)
1081 nz4(jlt_new) = nz4(i)
1082 p1(jlt_new) = p1(i)
1083 p2(jlt_new) = p2(i)
1084 p3(jlt_new) = p3(i)
1085 p4(jlt_new) = p4(i)
1086 lb1(jlt_new) = lb1(i)
1087 lb2(jlt_new) = lb2(i)
1088 lb3(jlt_new) = lb3(i)
1089 lb4(jlt_new) = lb4(i)
1090 lc1(jlt_new) = lc1(i)
1091 lc2(jlt_new) = lc2(i)
1092 lc3(jlt_new) = lc3(i)
1093 lc4(jlt_new) = lc4(i)
1094 stif(jlt_new) = stif(i)
1095 gapv(jlt_new) = gapv(i)
1096 gapr(jlt_new) = gapr(i)
1097 index(jlt_new)= index(i)
1098C
1099 kini(jlt_new) = kini(i)
1100 vxi(jlt_new) = vxi(i)
1101 vyi(jlt_new) = vyi(i)
1102 vzi(jlt_new) = vzi(i)
1103 msi(jlt_new) = msi(i)
1104C
1105 xi(jlt_new) = xi(i)
1106 yi(jlt_new) = yi(i)
1107 zi(jlt_new) = zi(i)
1108 x1(jlt_new) = x1(i)
1109 y1(jlt_new) = y1(i)
1110 z1(jlt_new) = z1(i)
1111 x2(jlt_new) = x2(i)
1112 y2(jlt_new) = y2(i)
1113 z2(jlt_new) = z2(i)
1114 x3(jlt_new) = x3(i)
1115 y3(jlt_new) = y3(i)
1116 z3(jlt_new) = z3(i)
1117 x4(jlt_new) = x4(i)
1118 y4(jlt_new) = y4(i)
1119 z4(jlt_new) = z4(i)
1120C
1121 tempi(jlt_new) = tempi(i)
1122 phi(jlt_new) = zero
1123 areasi(jlt_new) = areasi(i)
1124 ieleci(jlt_new) =ieleci(i)
1125C
1126 nsms(jlt_new) = nsms(i)
1127C
1128 ENDIF
1129 ENDDO
1130 ELSE !
1131 DO i=1,jlt
1132 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
1133 jlt_new = jlt_new + 1
1134 cn_loc(jlt_new) = cand_n(i)
1135 ce_loc(jlt_new) = cand_e(i)
1136 ix1(jlt_new) = ix1(i)
1137 ix2(jlt_new) = ix2(i)
1138 ix3(jlt_new) = ix3(i)
1139 ix4(jlt_new) = ix4(i)
1140 nsvg(jlt_new) = nsvg(i)
1141 nx1(jlt_new) = nx1(i)
1142 nx2(jlt_new) = nx2(i)
1143 nx3(jlt_new) = nx3(i)
1144 nx4(jlt_new) = nx4(i)
1145 ny1(jlt_new) = ny1(i)
1146 ny2(jlt_new) = ny2(i)
1147 ny3(jlt_new) = ny3(i)
1148 ny4(jlt_new) = ny4(i)
1149 nz1(jlt_new) = nz1(i)
1150 nz2(jlt_new) = nz2(i)
1151 nz3(jlt_new) = nz3(i)
1152 nz4(jlt_new) = nz4(i)
1153 p1(jlt_new) = p1(i)
1154 p2(jlt_new) = p2(i)
1155 p3(jlt_new) = p3(i)
1156 p4(jlt_new) = p4(i)
1157 lb1(jlt_new) = lb1(i)
1158 lb2(jlt_new) = lb2(i)
1159 lb3(jlt_new) = lb3(i)
1160 lb4(jlt_new) = lb4(i)
1161 lc1(jlt_new) = lc1(i)
1162 lc2(jlt_new) = lc2(i)
1163 lc3(jlt_new) = lc3(i)
1164 lc4(jlt_new) = lc4(i)
1165 stif(jlt_new) = stif(i)
1166 gapv(jlt_new) = gapv(i)
1167 gapr(jlt_new) = gapr(i)
1168 index(jlt_new)= index(i)
1169 kini(jlt_new) = kini(i)
1170 vxi(jlt_new) = vxi(i)
1171 vyi(jlt_new) = vyi(i)
1172 vzi(jlt_new) = vzi(i)
1173 msi(jlt_new) = msi(i)
1174 xi(jlt_new) = xi(i)
1175 yi(jlt_new) = yi(i)
1176 zi(jlt_new) = zi(i)
1177 x1(jlt_new) = x1(i)
1178 y1(jlt_new) = y1(i)
1179 z1(jlt_new) = z1(i)
1180 x2(jlt_new) = x2(i)
1181 y2(jlt_new) = y2(i)
1182 z2(jlt_new) = z2(i)
1183 x3(jlt_new) = x3(i)
1184 y3(jlt_new) = y3(i)
1185 z3(jlt_new) = z3(i)
1186 x4(jlt_new) = x4(i)
1187 y4(jlt_new) = y4(i)
1188 z4(jlt_new) = z4(i)
1189 rcurvi(jlt_new) = rcurvi(i)
1190 anglmi(jlt_new) = anglmi(i)
1191 tempi(jlt_new) = tempi(i)
1192 phi(jlt_new) = zero
1193 areasi(jlt_new) = areasi(i)
1194 ieleci(jlt_new) =ieleci(i)
1195C
1196 nsms(jlt_new) = nsms(i)
1197 ENDIF
1198 ENDDO
1199 ENDIF
1200 ENDIF
1201 END IF
1202C
1203 RETURN
1204 END
1205!||====================================================================
1206!|| i20cgap0 ../engine/source/interfaces/int20/i20dst3.F
1207!||--- called by ------------------------------------------------------
1208!|| i20dst3 ../engine/source/interfaces/int20/i20dst3.F
1209!||====================================================================
1210 SUBROUTINE i20cgap0(X10,Y10,Z10,X20,Y20,Z20,
1211 . X30,Y30,Z30,X40,Y40,Z40,
1212 . X1,Y1,Z1,X2,Y2,Z2,
1213 . X3,Y3,Z3,X4,Y4,Z4,GAP_M)
1214C-----------------------------------------------
1215C I m p l i c i t T y p e s
1216C-----------------------------------------------
1217#include "implicit_f.inc"
1218C-----------------------------------------------
1219C D u m m y A r g u m e n t s
1220C-----------------------------------------------
1221 my_real
1222 . x10,y10,z10,x20,y20,z20,x30,y30,z30,x40,y40,z40,
1223 . x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4,gap_m
1224C-----------------------------------------------
1225C L o c a l V a r i a b l e s
1226C-----------------------------------------------
1227 my_real
1228 . l12,l12x,l12y,l12z,
1229 . l23,l23x,l23y,l23z,l14,l14x,l14y,l14z,aaa,bbb,l1214,l1223
1230C=======================================================================
1231 l12x = x20-x10
1232 l12y = y20-y10
1233 l12z = z20-z10
1234 l12 = sqrt(l12x*l12x+l12y*l12y+l12z*l12z)
1235 aaa = one/max(l12,em30)
1236 l12x = l12x*aaa
1237 l12y = l12y*aaa
1238 l12z = l12z*aaa
1239
1240 l14x = x40-x10
1241 l14y = y40-y10
1242 l14z = z40-z10
1243 l14 = sqrt(l14x*l14x+l14y*l14y+l14z*l14z)
1244 aaa = one/max(l14,em30)
1245 l14x = l14x*aaa
1246 l14y = l14y*aaa
1247 l14z = l14z*aaa
1248
1249 l23x = x30-x20
1250 l23y = y30-y20
1251 l23z = z30-z20
1252 l23 = sqrt(l23x*l23x+l23y*l23y+l23z*l23z)
1253 aaa = one/max(l23,em30)
1254 l23x = l23x*aaa
1255 l23y = l23y*aaa
1256 l23z = l23z*aaa
1257
1258 l1214 = l12x*l14x+l12y*l14y+l12z*l14z
1259
1260 bbb = gap_m*(one+em5)/max(sqrt(one-l1214*l1214),em30)
1261 aaa = min(l12/three,bbb)
1262
1263 x1 = x1 + l14x*aaa
1264 y1 = y1 + l14y*aaa
1265 z1 = z1 + l14z*aaa
1266
1267 l1223 = l12x*l23x+l12y*l23y+l12z*l23z
1268
1269 bbb = gap_m*(one+em5)/max(sqrt(one-l1223*l1223),em30)
1270 aaa = min(l14/three,bbb)
1271
1272 x2 = x2 + l23x*aaa
1273 y2 = y2 + l23y*aaa
1274 z2 = z2 + l23z*aaa
1275
1276 RETURN
1277 END
1278!||====================================================================
1279!|| i20cgap1 ../engine/source/interfaces/int20/i20dst3.F
1280!||--- called by ------------------------------------------------------
1281!|| i20dst3 ../engine/source/interfaces/int20/i20dst3.F
1282!||====================================================================
1283 SUBROUTINE i20cgap1(X10,Y10,Z10,X20,Y20,Z20,
1284 . X40,Y40,Z40,
1285 . X1,Y1,Z1,X2,Y2,Z2,
1286 . X4,Y4,Z4,GAP_M)
1287C-----------------------------------------------
1288C I m p l i c i t T y p e s
1289C-----------------------------------------------
1290#include "implicit_f.inc"
1291C-----------------------------------------------
1292C D u m m y A r g u m e n t s
1293C-----------------------------------------------
1294 my_real
1295 . x10,y10,z10,x20,y20,z20,x40,y40,z40,
1296 . x1,y1,z1,x2,y2,z2,x4,y4,z4,gap_m
1297C-----------------------------------------------
1298C L o c a l V a r i a b l e s
1299C-----------------------------------------------
1300 my_real
1301 . l12,l12x,l12y,l12z,l14,l14x,l14y,l14z,aaa,bbb,l1214
1302C=======================================================================
1303 l12x = x20-x10
1304 l12y = y20-y10
1305 l12z = z20-z10
1306 l12 = sqrt(l12x*l12x+l12y*l12y+l12z*l12z)
1307 aaa = one/max(l12,em30)
1308 l12x = l12x*aaa
1309 l12y = l12y*aaa
1310 l12z = l12z*aaa
1311
1312 l14x = x40-x10
1313 l14y = y40-y10
1314 l14z = z40-z10
1315 l14 = sqrt(l14x*l14x+l14y*l14y+l14z*l14z)
1316 aaa = one/max(l14,em30)
1317 l14x = l14x*aaa
1318 l14y = l14y*aaa
1319 l14z = l14z*aaa
1320
1321 l1214 = l12x*l14x+l12y*l14y+l12z*l14z
1322
1323 bbb = gap_m*(one+em5)/max(sqrt(one-l1214*l1214),em30)
1324 aaa = min(l12/three,bbb)
1325
1326 x1 = x1 + l12x*aaa
1327 y1 = y1 + l12y*aaa
1328 z1 = z1 + l12z*aaa
1329
1330 aaa = min(l14/three,bbb)
1331
1332 x1 = x1 + l14x*aaa
1333 y1 = y1 + l14y*aaa
1334 z1 = z1 + l14z*aaa
1335
1336 RETURN
1337 END
my_real
#define my_real
Definition cppsort.cpp:32
i20cgap1
subroutine i20cgap1(x10, y10, z10, x20, y20, z20, x40, y40, z40, x1, y1, z1, x2, y2, z2, x4, y4, z4, gap_m)
Definition i20dst3.F:1287
i20dst3
subroutine i20dst3(jlt, cand_n, cand_e, cn_loc, ce_loc, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, nx1, nx2, nx3, nx4, ny1, ny2, ny3, ny4, nz1, nz2, nz3, nz4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, p1, p2, p3, p4, ix1, ix2, ix3, ix4, nsvg, stif, jlt_new, gapv, inacti, solidn_normal, index, vxi, vyi, gapr, gap_sh, vzi, msi, kini, icurv, irect, nnx1, nnx2, nnx3, nnx4, nny1, nny2, nny3, nny4, nnz1, nnz2, nnz3, nnz4, nod_normal, iadm, rcurvi, anglmi, intth, tempi, phi, areasi, ieleci, nln, nlg, igap, gapmax, solidn_normal_f, nsms, nbinflg, gap_m, cmaj)
Definition i20dst3.F:54
i20cgap0
subroutine i20cgap0(x10, y10, z10, x20, y20, z20, x30, y30, z30, x40, y40, z40, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, gap_m)
Definition i20dst3.F:1214
i20cmaj
subroutine i20cmaj(jlt, cmaj, irect, nod_normal, cand_e, x1, x2, x3, x4, nln, y1, y2, y3, y4, nlg, z1, z2, z3, z4, nnx1, nnx2, nnx3, nnx4, nny1, nny2, nny3, nny4, nnz1, nnz2, nnz3, nnz4)
Definition i20curv.F:605
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21