OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i15tott1.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!|| i15tott1 ../engine/source/interfaces/int15/i15tott1.F
25!||--- called by ------------------------------------------------------
26!|| i15cmp ../engine/source/interfaces/int15/i15cmp.F
27!||--- uses -----------------------------------------------------
28!|| groupdef_mod ../common_source/modules/groupdef_mod.F
29!||====================================================================
30 SUBROUTINE i15tott1(NOINT ,NDEB ,NTC ,X ,KSURF ,
31 2 IGRSURF ,BUFSF ,KTC ,KSI ,NOLD ,
32 3 XP1 ,XP2 ,XP3 ,XTK ,YTK ,
33 4 ZTK ,NTX ,NTY ,NTZ ,PENET ,
34 5 DEPTH ,XI ,YI ,ZI ,NXI ,
35 6 NYI ,NZI ,ANSMX ,HOLD ,IACTIV,
36 7 ITAB )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE groupdef_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45#include "comlock.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com04_c.inc"
54#include "units_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER KSURF ,KSI(4,*) ,
59 . NOINT ,NDEB ,NTC, IACTIV(4,*), KTC(*), ITAB(*)
60C REAL
61 my_real
62 . X(3,*) ,BUFSF(*) ,NOLD(3,*) ,
63 . XTK(*) ,YTK(*) ,ZTK(*) ,NTX(*) ,NTY(*) ,NTZ(*) ,
64 . penet(*) ,depth(*) ,xi(*) ,yi(*) ,zi(*) ,
65 . nxi(*) ,nyi(*) ,nzi(*) ,xp1(3,mvsiz), xp2(3,mvsiz),
66 . xp3(3,mvsiz), ansmx, hold(3,*)
67 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER ADRBUF, I, IL, NLS, IDG,
72 . IN1, IN2, IN3,
73 . inside1,inside2
74 my_real
75 . a, b, c, an, bn, cn, rot(9), dgr, expn,
76 . xg, yg, zg,
77 . ntn,
78 . n1, n2, n3, n, n11,n12,n13,nr1,n21,n22,n23,nr2,
79 . xkn1, ykn1, zkn1, sgnxkn, sgnykn, sgnzkn, xkn, ykn, zkn, eh,
80 . lambda1, lambda2, alp, bet,
81 . xh , yh , zh , mu, xh1, yh1, zh1, mu1, xh2, yh2, zh2, mu2,
82 . dx1, dy1, dz1, dx2, dy2, dz2, dx3, dy3, dz3,
83 . side1, side2, oldnx, oldny, oldnz, out, ps, nr,
84 . lambda, em, ep
85 my_real
86 . x1(mvsiz), y1(mvsiz), z1(mvsiz),
87 . x2(mvsiz), y2(mvsiz), z2(mvsiz),
88 . x3(mvsiz), y3(mvsiz), z3(mvsiz),
89 . x12(mvsiz), y12(mvsiz), z12(mvsiz),
90 . x13(mvsiz), y13(mvsiz), z13(mvsiz),
91 . x23(mvsiz), y23(mvsiz), z23(mvsiz),
92 . xm(mvsiz) , ym(mvsiz) , zm(mvsiz) ,
93 . xtk2(mvsiz) , ytk2(mvsiz) , ztk2(mvsiz) ,
94 . d(mvsiz)
95C-----------------------------------------------
96 adrbuf=igrsurf(ksurf)%IAD_BUFR
97 a =bufsf(adrbuf+1)
98 b =bufsf(adrbuf+2)
99 c =bufsf(adrbuf+3)
100 dgr =bufsf(adrbuf+36)
101 idg =nint(dgr)
102 dgr =idg
103 dgr =max(two,dgr)
104 expn=dgr/(dgr-one)
105 an=a**dgr
106 bn=b**dgr
107 cn=c**dgr
108 an=one/max(em20,an)
109 bn=one/max(em20,bn)
110 cn=one/max(em20,cn)
111 DO i=1,9
112 rot(i)=bufsf(adrbuf+7+i-1)
113 END DO
114C-------------------------------
115C Passage au repere local :
116C-------------------------------
117 DO 75 nls=ndeb+1,min(ndeb+mvsiz,ntc)
118 il =ktc(nls)
119 i =nls-ndeb
120 in1=ksi(1,il)
121 in2=ksi(2,il)
122 in3=ksi(3,il)
123C Passage au repere local.
124 xg=x(1,in1)-bufsf(adrbuf+4)
125 yg=x(2,in1)-bufsf(adrbuf+5)
126 zg=x(3,in1)-bufsf(adrbuf+6)
127 xp1(1,i)=rot(1)*xg+rot(2)*yg+rot(3)*zg
128 xp1(2,i)=rot(4)*xg+rot(5)*yg+rot(6)*zg
129 xp1(3,i)=rot(7)*xg+rot(8)*yg+rot(9)*zg
130 xg=x(1,in2)-bufsf(adrbuf+4)
131 yg=x(2,in2)-bufsf(adrbuf+5)
132 zg=x(3,in2)-bufsf(adrbuf+6)
133 xp2(1,i)=rot(1)*xg+rot(2)*yg+rot(3)*zg
134 xp2(2,i)=rot(4)*xg+rot(5)*yg+rot(6)*zg
135 xp2(3,i)=rot(7)*xg+rot(8)*yg+rot(9)*zg
136 xg=x(1,in3)-bufsf(adrbuf+4)
137 yg=x(2,in3)-bufsf(adrbuf+5)
138 zg=x(3,in3)-bufsf(adrbuf+6)
139 xp3(1,i)=rot(1)*xg+rot(2)*yg+rot(3)*zg
140 xp3(2,i)=rot(4)*xg+rot(5)*yg+rot(6)*zg
141 xp3(3,i)=rot(7)*xg+rot(8)*yg+rot(9)*zg
142 75 CONTINUE
143C-------------------------------
144 DO 100 nls=ndeb+1,min(ndeb+mvsiz,ntc)
145 il =ktc(nls)
146 i =nls-ndeb
147C-----
148 x1(i)=xp1(1,i)
149 y1(i)=xp1(2,i)
150 z1(i)=xp1(3,i)
151 x2(i)=xp2(1,i)
152 y2(i)=xp2(2,i)
153 z2(i)=xp2(3,i)
154 x3(i)=xp3(1,i)
155 y3(i)=xp3(2,i)
156 z3(i)=xp3(3,i)
157 x12(i)=x2(i)-x1(i)
158 y12(i)=y2(i)-y1(i)
159 z12(i)=z2(i)-z1(i)
160 x13(i)=x3(i)-x1(i)
161 y13(i)=y3(i)-y1(i)
162 z13(i)=z3(i)-z1(i)
163 n1=y12(i)*z13(i)-z12(i)*y13(i)
164 n2=z12(i)*x13(i)-x12(i)*z13(i)
165 n3=x12(i)*y13(i)-y12(i)*x13(i)
166 ntn=one/max(em20,sqrt(n1*n1+n2*n2+n3*n3))
167 ntx(i)=ntn*n1
168 nty(i)=ntn*n2
169 ntz(i)=ntn*n3
170 d(i) =-ntx(i)*x1(i)-nty(i)*y1(i)-ntz(i)*z1(i)
171C-----
172 x23(i)=x3(i)-x2(i)
173 y23(i)=y3(i)-y2(i)
174 z23(i)=z3(i)-z2(i)
175 100 CONTINUE
176C-------------------------------
177C POINTS K,H SUR E,L / LA DISTANCE D(K,H) EST LOCALEMENT MAXIMUM
178C-------------------------------
179 DO 125 nls=ndeb+1,min(ndeb+mvsiz,ntc)
180 il =ktc(nls)
181 i =nls-ndeb
182C-----
183 eh =(abs(ntx(i)/(dgr*an))**expn)*an
184 . +(abs(nty(i)/(dgr*bn))**expn)*bn
185 . +(abs(ntz(i)/(dgr*cn))**expn)*cn
186C X EST DU SIGNE DE LAMBDA*NTX, IDEM EN Y ET Z.
187C LAMBDA1=EXP(LOG(1./EH)/EXPN)
188 lambda1=(max(em20,eh))**(-one/expn)
189 xh1 =abs(lambda1*ntx(i)/(dgr*an))**(one/(dgr-one))
190 IF (ntx(i)<zero) xh1=-xh1
191 yh1 =abs(lambda1*nty(i)/(dgr*bn))**(one/(dgr-one))
192 IF (nty(i)<zero) yh1=-yh1
193 zh1 =abs(lambda1*ntz(i)/(dgr*cn))**(one/(dgr-one))
194 IF (ntz(i)<zero) zh1=-zh1
195 mu1 =-ntx(i)*xh1-nty(i)*yh1-ntz(i)*zh1-d(i)
196C LAMBDA2=-LAMBDA1
197 xh2 =-xh1
198 yh2 =-yh1
199 zh2 =-zh1
200C MU2 =-NTX(I)*XH2-NTY(I)*YH2-NTZ(I)*ZH2-D(I)
201 mu2=-mu1-two*d(i)
202 xtk(i) =xh1+mu1*ntx(i)
203 ytk(i) =yh1+mu1*nty(i)
204 ztk(i) =zh1+mu1*ntz(i)
205 xtk2(i)=xh2+mu2*ntx(i)
206 ytk2(i)=yh2+mu2*nty(i)
207 ztk2(i)=zh2+mu2*ntz(i)
208C-------------------------------
209 125 CONTINUE
210C-------------------------------
211C RAMENER LE PT PK SUR LE TRIANGLE.
212C-------------------------------
213 DO 150 nls=ndeb+1,min(ndeb+mvsiz,ntc)
214 il =ktc(nls)
215 i =nls-ndeb
216C-----
217 dx1=xtk(i)-x1(i)
218 dy1=ytk(i)-y1(i)
219 dz1=ztk(i)-z1(i)
220 dx2=xtk(i)-x2(i)
221 dy2=ytk(i)-y2(i)
222 dz2=ztk(i)-z2(i)
223 out = (dy1*dz2-dy2*dz1)*ntx(i)
224 . +(dz1*dx2-dz2*dx1)*nty(i)
225 . +(dx1*dy2-dy1*dx2)*ntz(i)
226 IF (out<zero) THEN
227C PROJECTION SUR 1,2
228 ps =dx1*x12(i)+dy1*y12(i)+dz1*z12(i)
229 nr =x12(i)*x12(i)+y12(i)*y12(i)+z12(i)*z12(i)
230 bet=ps/max(em20,nr)
231 bet=max(bet,zero)
232 bet=min(bet,one)
233 alp=1.-bet
234 xtk(i)=alp*x1(i)+bet*x2(i)
235 ytk(i)=alp*y1(i)+bet*y2(i)
236 ztk(i)=alp*z1(i)+bet*z2(i)
237 ENDIF
238 dx3=xtk(i)-x3(i)
239 dy3=ytk(i)-y3(i)
240 dz3=ztk(i)-z3(i)
241 out = (dy2*dz3-dy3*dz2)*ntx(i)
242 . +(dz2*dx3-dz3*dx2)*nty(i)
243 . +(dx2*dy3-dy2*dx3)*ntz(i)
244 IF (out<zero) THEN
245C PROJECTION SUR 2,3
246 ps =dx2*x23(i)+dy2*y23(i)+dz2*z23(i)
247 nr =x23(i)*x23(i)+y23(i)*y23(i)+z23(i)*z23(i)
248 bet=ps/max(em20,nr)
249 bet=max(bet,zero)
250 bet=min(bet,one)
251 alp=1.-bet
252 xtk(i)=alp*x2(i)+bet*x3(i)
253 ytk(i)=alp*y2(i)+bet*y3(i)
254 ztk(i)=alp*z2(i)+bet*z3(i)
255 ENDIF
256 out = (dy3*dz1-dy1*dz3)*ntx(i)
257 . +(dz3*dx1-dz1*dx3)*nty(i)
258 . +(dx3*dy1-dy3*dx1)*ntz(i)
259 IF (out<0.) THEN
260C PROJECTION SUR 3,1
261 ps =-dx3*x13(i)-dy3*y13(i)-dz3*z13(i)
262 nr =x13(i)*x13(i)+y13(i)*y13(i)+z13(i)*z13(i)
263 bet=ps/max(em20,nr)
264 bet=max(bet,zero)
265 bet=min(bet,one)
266 alp=1.-bet
267 xtk(i)=alp*x3(i)+bet*x1(i)
268 ytk(i)=alp*y3(i)+bet*y1(i)
269 ztk(i)=alp*z3(i)+bet*z1(i)
270 ENDIF
271C-----
272 dx1=xtk2(i)-x1(i)
273 dy1=ytk2(i)-y1(i)
274 dz1=ztk2(i)-z1(i)
275 dx2=xtk2(i)-x2(i)
276 dy2=ytk2(i)-y2(i)
277 dz2=ztk2(i)-z2(i)
278 out = (dy1*dz2-dy2*dz1)*ntx(i)
279 . +(dz1*dx2-dz2*dx1)*nty(i)
280 . +(dx1*dy2-dy1*dx2)*ntz(i)
281 IF (out<zero) THEN
282C PROJECTION SUR 1,2
283 ps =dx1*x12(i)+dy1*y12(i)+dz1*z12(i)
284 nr =x12(i)*x12(i)+y12(i)*y12(i)+z12(i)*z12(i)
285 bet=ps/max(em20,nr)
286 bet=max(bet,zero)
287 bet=min(bet,one)
288 alp=1.-bet
289 xtk2(i)=alp*x1(i)+bet*x2(i)
290 ytk2(i)=alp*y1(i)+bet*y2(i)
291 ztk2(i)=alp*z1(i)+bet*z2(i)
292 ENDIF
293 dx3=xtk2(i)-x3(i)
294 dy3=ytk2(i)-y3(i)
295 dz3=ztk2(i)-z3(i)
296 out = (dy2*dz3-dy3*dz2)*ntx(i)
297 . +(dz2*dx3-dz3*dx2)*nty(i)
298 . +(dx2*dy3-dy2*dx3)*ntz(i)
299 IF (out<zero) THEN
300C PROJECTION SUR 2,3
301 ps =dx2*x23(i)+dy2*y23(i)+dz2*z23(i)
302 nr =x23(i)*x23(i)+y23(i)*y23(i)+z23(i)*z23(i)
303 bet=ps/max(em20,nr)
304 bet=max(bet,zero)
305 bet=min(bet,one)
306 alp=1.-bet
307 xtk2(i)=alp*x2(i)+bet*x3(i)
308 ytk2(i)=alp*y2(i)+bet*y3(i)
309 ztk2(i)=alp*z2(i)+bet*z3(i)
310 ENDIF
311 out = (dy3*dz1-dy1*dz3)*ntx(i)
312 . +(dz3*dx1-dz1*dx3)*nty(i)
313 . +(dx3*dy1-dy3*dx1)*ntz(i)
314 IF (out<0.) THEN
315C PROJECTION SUR 3,1
316 ps =-dx3*x13(i)-dy3*y13(i)-dz3*z13(i)
317 nr =x13(i)*x13(i)+y13(i)*y13(i)+z13(i)*z13(i)
318 bet=ps/max(em20,nr)
319 bet=max(bet,zero)
320 bet=min(bet,one)
321 alp=1.-bet
322 xtk2(i)=alp*x3(i)+bet*x1(i)
323 ytk2(i)=alp*y3(i)+bet*y1(i)
324 ztk2(i)=alp*z3(i)+bet*z1(i)
325 ENDIF
326C-------------------------------
327 150 CONTINUE
328C-------------------------------
329C PROJECTION DE PK SUR L ET PENETRATION.
330C-------------------------------
331 DO 175 nls=ndeb+1,min(ndeb+mvsiz,ntc)
332 il =ktc(nls)
333 i =nls-ndeb
334 IF (iactiv(1,il)==-1) GOTO 175
335C-----
336 xh =xtk(i)
337 yh =ytk(i)
338 zh =ztk(i)
339 xkn1 =xh**(idg-1)
340 sgnxkn=-one
341 IF (xkn1*xh>=zero) sgnxkn=one
342 ykn1 =yh**(idg-1)
343 sgnykn=-one
344 IF (ykn1*yh>=zero) sgnykn=one
345 zkn1 =zh**(idg-1)
346 sgnzkn=-one
347 IF (zkn1*zh>=zero) sgnzkn=one
348 n11 =sgnxkn*xkn1*an
349 n12 =sgnykn*ykn1*bn
350 n13 =sgnzkn*zkn1*cn
351 nr1 =n11*n11+n12*n12+n13*n13
352 nr1 =sqrt(nr1)
353 em =n11*xtk(i)+n12*ytk(i)+n13*ztk(i)
354 IF (em<=one) THEN
355 lambda1=(em-exp((dgr-one)*log(max(em,em20))/dgr))
356 . / max(exp((dgr-one)*log(em20)/dgr),nr1)
357 inside1=1
358 ELSE
359 inside1=0
360 ENDIF
361C-----
362 xh =xtk2(i)
363 yh =ytk2(i)
364 zh =ztk2(i)
365 xkn1 =xh**(idg-1)
366 sgnxkn=-one
367 IF (xkn1*xh>=zero) sgnxkn=one
368 ykn1 =yh**(idg-1)
369 sgnykn=-one
370 IF (ykn1*yh>=zero) sgnykn=one
371 zkn1 =zh**(idg-1)
372 sgnzkn=-one
373 IF (zkn1*zh>=zero) sgnzkn=one
374 n21 =sgnxkn*xkn1*an
375 n22 =sgnykn*ykn1*bn
376 n23 =sgnzkn*zkn1*cn
377 nr2 =n21*n21+n22*n22+n23*n23
378 nr2 =sqrt(nr2)
379 em =n21*xtk2(i)+n22*ytk2(i)+n23*ztk2(i)
380 IF (em<=one) THEN
381 lambda2=(em-exp((dgr-one)*log(max(em,em20))/dgr))
382 . / max(exp((dgr-one)*log(em20)/dgr),nr2)
383 inside2=1
384 ELSE
385 inside2=0
386 ENDIF
387C-----
388 IF (inside1==0.AND.inside2==0) THEN
389 iactiv(1,il)=0
390 ELSE
391C-----
392 IF (iactiv(1,il)==0) THEN
393 IF (inside1/=0.AND.inside2/=0) THEN
394 IF (abs(lambda1)>=abs(lambda2)) THEN
395 xm(i)=xtk(i)-lambda1*n11/max(em20,nr1)
396 ym(i)=ytk(i)-lambda1*n12/max(em20,nr1)
397 zm(i)=ztk(i)-lambda1*n13/max(em20,nr1)
398 ELSE
399 xm(i)=xtk2(i)-lambda2*n21/max(em20,nr2)
400 ym(i)=ytk2(i)-lambda2*n22/max(em20,nr2)
401 zm(i)=ztk2(i)-lambda2*n23/max(em20,nr2)
402 xtk(i)=xtk2(i)
403 ytk(i)=ytk2(i)
404 ztk(i)=ztk2(i)
405 ENDIF
406 ELSEIF(inside1/=0) THEN
407 xm(i)=xtk(i)-lambda1*n11/max(em20,nr1)
408 ym(i)=ytk(i)-lambda1*n12/max(em20,nr1)
409 zm(i)=ztk(i)-lambda1*n13/max(em20,nr1)
410 ELSEIF(inside2/=0) THEN
411 xm(i)=xtk2(i)-lambda2*n21/max(em20,nr2)
412 ym(i)=ytk2(i)-lambda2*n22/max(em20,nr2)
413 zm(i)=ztk2(i)-lambda2*n23/max(em20,nr2)
414 xtk(i)=xtk2(i)
415 ytk(i)=ytk2(i)
416 ztk(i)=ztk2(i)
417 ENDIF
418C-----
419 ELSE
420 xh=hold(1,4*(il-1)+1)
421 yh=hold(2,4*(il-1)+1)
422 zh=hold(3,4*(il-1)+1)
423 n1=nold(1,4*(il-1)+1)
424 n2=nold(2,4*(il-1)+1)
425 n3=nold(3,4*(il-1)+1)
426 lambda1=(xh-xtk(i))*n1
427 . +(yh-ytk(i))*n2
428 . +(zh-ztk(i))*n3
429 lambda2=(xh-xtk2(i))*n1
430 . +(yh-ytk2(i))*n2
431 . +(zh-ztk2(i))*n3
432 IF (inside1/=0.AND.inside2/=0) THEN
433 IF (abs(lambda1)>=abs(lambda2)) THEN
434 xm(i)=xtk(i)+lambda1*n1
435 ym(i)=ytk(i)+lambda1*n2
436 zm(i)=ztk(i)+lambda1*n3
437 ELSE
438 xm(i)=xtk2(i)+lambda2*n1
439 ym(i)=ytk2(i)+lambda2*n2
440 zm(i)=ztk2(i)+lambda2*n3
441 xtk(i)=xtk2(i)
442 ytk(i)=ytk2(i)
443 ztk(i)=ztk2(i)
444 ENDIF
445 ELSEIF(inside1/=0) THEN
446 xm(i)=xtk(i)+lambda1*n1
447 ym(i)=ytk(i)+lambda1*n2
448 zm(i)=ztk(i)+lambda1*n3
449 ELSEIF(inside2/=0) THEN
450 xm(i)=xtk2(i)+lambda2*n1
451 ym(i)=ytk2(i)+lambda2*n2
452 zm(i)=ztk2(i)+lambda2*n3
453 xtk(i)=xtk2(i)
454 ytk(i)=ytk2(i)
455 ztk(i)=ztk2(i)
456 ENDIF
457C one more iteration.
458 xkn1 =xm(i)**(idg-1)
459 sgnxkn=-one
460 IF (xkn1*xm(i)>=zero) sgnxkn=one
461 ykn1 =ym(i)**(idg-1)
462 sgnykn=-one
463 IF (ykn1*ym(i)>=zero) sgnykn=one
464 zkn1 =zm(i)**(idg-1)
465 sgnzkn=-one
466 IF (zkn1*zm(i)>=zero) sgnzkn=one
467 n1 =sgnxkn*xkn1*an
468 n2 =sgnykn*ykn1*bn
469 n3 =sgnzkn*zkn1*cn
470 em=n1*xm(i)+n2*ym(i)+n3*zm(i)
471 xm(i)=xm(i)/max(em20,em**(one/dgr))
472 ym(i)=ym(i)/max(em20,em**(one/dgr))
473 zm(i)=zm(i)/max(em20,em**(one/dgr))
474 xkn1 =xm(i)**(idg-1)
475 sgnxkn=-one
476 IF (xkn1*xm(i)>=zero) sgnxkn=one
477 ykn1 =ym(i)**(idg-1)
478 sgnykn=-one
479 IF (ykn1*ym(i)>=zero) sgnykn=one
480 zkn1 =zm(i)**(idg-1)
481 sgnzkn=-one
482 IF (zkn1*zm(i)>=zero) sgnzkn=one
483 n1 =sgnxkn*xkn1*an
484 n2 =sgnykn*ykn1*bn
485 n3 =sgnzkn*zkn1*cn
486 nr =n1*n1+n2*n2+n3*n3
487 nr =one/max(em20,sqrt(nr))
488 n1 =n1*nr
489 n2 =n2*nr
490 n3 =n3*nr
491 lambda1=(xm(i)-xtk(i))*n1
492 . +(ym(i)-ytk(i))*n2
493 . +(zm(i)-ztk(i))*n3
494 xm(i)=xtk(i)+lambda1*n1
495 ym(i)=ytk(i)+lambda1*n2
496 zm(i)=ztk(i)+lambda1*n3
497 ENDIF
498 iactiv(1,il)=iactiv(1,il)+1
499 ENDIF
500 175 CONTINUE
501C-----
502#include "vectorize.inc"
503 DO 200 nls=ndeb+1,min(ndeb+mvsiz,ntc)
504 il =ktc(nls)
505 i =nls-ndeb
506C-----
507 IF (iactiv(1,il)<=0) GOTO 200
508C-----
509C projection radiale de M.
510 xkn1 =xm(i)**(idg-1)
511 sgnxkn=-one
512 IF (xkn1*xm(i)>=zero) sgnxkn=one
513 ykn1 =ym(i)**(idg-1)
514 sgnykn=-one
515 IF (ykn1*ym(i)>=zero) sgnykn=one
516 zkn1 =zm(i)**(idg-1)
517 sgnzkn=-one
518 IF (zkn1*zm(i)>=zero) sgnzkn=one
519 n1 =sgnxkn*xkn1*an
520 n2 =sgnykn*ykn1*bn
521 n3 =sgnzkn*zkn1*cn
522 em=n1*xm(i)+n2*ym(i)+n3*zm(i)
523C------
524 xm(i)=xm(i)/max(em20,em**(one/dgr))
525 ym(i)=ym(i)/max(em20,em**(one/dgr))
526 zm(i)=zm(i)/max(em20,em**(one/dgr))
527C-----
528C normale a l'ellipsoide en M.
529 xkn1 =xm(i)**(idg-1)
530 sgnxkn=-one
531 IF (xkn1*xm(i)>=zero) sgnxkn=one
532 ykn1 =ym(i)**(idg-1)
533 sgnykn=-one
534 IF (ykn1*ym(i)>=zero) sgnykn=one
535 zkn1 =zm(i)**(idg-1)
536 sgnzkn=-one
537 IF (zkn1*zm(i)>=zero) sgnzkn=one
538 n1 =sgnxkn*xkn1*an
539 n2 =sgnykn*ykn1*bn
540 n3 =sgnzkn*zkn1*cn
541 nr =n1*n1+n2*n2+n3*n3
542 nr =one/max(em20,sqrt(nr))
543C-----
544 nxi(i)=n1*nr
545 nyi(i)=n2*nr
546 nzi(i)=n3*nr
547 xi(i)=xm(i)
548 yi(i)=ym(i)
549 zi(i)=zm(i)
550 depth(i)=xm(i)*nxi(i)+ym(i)*nyi(i)+zm(i)*nzi(i)
551C------
552 penet(i)=(xtk(i)-xm(i))*nxi(i)
553 . +(ytk(i)-ym(i))*nyi(i)
554 . +(ztk(i)-zm(i))*nzi(i)
555 penet(i)=-penet(i)
556 penet(i)=max(zero,penet(i))
557 IF (depth(i)-penet(i)<em10*depth(i)) THEN
558 penet(i) =zero
559 iactiv(1,il)=-2
560 ENDIF
561 ansmx=max(ansmx,penet(i))
562 200 CONTINUE
563C-------------------------------
564C MESSAGES DESACTIVATION
565C-------------------------------
566 DO 210 nls=ndeb+1,min(ndeb+mvsiz,ntc)
567 il =ktc(nls)
568 i =nls-ndeb
569C-----
570 IF (iactiv(1,il)==-2) THEN
571 in1=itab(ksi(1,il))
572 in2=itab(ksi(2,il))
573 in3=itab(ksi(3,il))
574#include "lockon.inc"
575 WRITE(istdo,'(A,I8)')' WARNING INTERFACE ',noint
576 WRITE(istdo,'(A,A,A,3I8)')' ELEMENT/SEGMENT',
577 . ' DE-ACTIVATED FROM INTERFACE;',
578 . ' element/segment nodes:',
579 . IN1,IN2,IN3
580 WRITE(IOUT ,'(a,i8)')' warning INTERFACE ',NOINT
581 WRITE(IOUT,'(a,a,a,3i8)')' element/segment',
582 . ' de-activated from interface;',
583 . ' element/segment nodes:',
584 . IN1,IN2,IN3
585#include "lockoff.inc"
586 IACTIV(1,IL)=-1
587 ENDIF
588 210 CONTINUE
589C------------------------------------------------------------
590 RETURN
591 END
i15tott1
subroutine i15tott1(noint, ndeb, ntc, x, ksurf, igrsurf, bufsf, ktc, ksi, nold, xp1, xp2, xp3, xtk, ytk, ztk, ntx, nty, ntz, penet, depth, xi, yi, zi, nxi, nyi, nzi, ansmx, hold, iactiv, itab)
Definition i15tott1.F:37
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662