OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i21cor3.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!|| i21cor3 ../engine/source/interfaces/int21/i21cor3.F
25!||--- called by ------------------------------------------------------
26!|| i21mainf ../engine/source/interfaces/int21/i21mainf.F
27!||--- uses -----------------------------------------------------
28!|| intstamp_glob_mod ../engine/share/modules/intstamp_glob_mod.F
29!|| tri7box ../engine/share/modules/tri7box.F
30!||====================================================================
31 SUBROUTINE i21cor3(JLT ,NIN ,X ,IRECT ,NSN ,
32 2 NSV ,CAND_E ,CAND_N ,STF ,STFN ,
33 3 XM0 ,NOD_NORMAL,IRTLM ,CSTS ,MSR ,
34 4 MS ,V ,XI ,YI ,ZI ,
35 5 IX1 ,IX2 ,IX3 ,IX4 ,NSVG ,
36 6 IGSTI ,STIF ,KMIN ,KMAX ,IGAP ,
37 7 GAP ,GAP_S ,GAPV ,GAPMAX,GAPMIN,
38 8 NX ,NY ,NZ ,PENE ,VXM ,
39 9 VYM ,VZM ,VXI ,VYI ,VZI ,
40 A MSI ,ITRIA ,LB ,LC ,IADM ,
41 B RCURV ,ANGLM ,NRADM ,ANGLT ,RCURVI,
42 C ANGLMI ,FXT ,FYT ,FZT ,FTXSAV,
43 D FTYSAV ,FTZSAV ,GAP_S0 ,AREA_S0,GAP0 ,
44 E AREA0 ,INTTH ,TEMP ,TEMPI ,IROT ,
45 F XG ,ROT ,AS ,BS ,ASI ,
46 G BSI ,XP ,YP ,ZP ,NODNX_SMS,
47 H NSMS ,MSTR ,PENI ,IFPEN ,ILEV ,
48 I X1 ,Y1 ,Z1 ,X2 ,Y2 ,
49 J Z2 ,X3 ,Y3 ,Z3 ,X4 ,
50 K Y4 ,Z4 ,DRAD ,PENRAD ,TINT ,
51 L TEMPM ,IFORM ,H1 ,H2 ,H3 ,
52 N H4 ,DIST ,ITAB ,NOINT ,DEPTH,
53 M INVN ,INTFRIC,IPARTFRICS,IPARTFRICSI,IPARTFRICM,
54 G IPARTFRICMI,NRTM)
55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE intstamp_glob_mod
59 USE tri7box
60C-----------------------------------------------
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64#include "comlock.inc"
65C-----------------------------------------------
66C G l o b a l P a r a m e t e r s
67C-----------------------------------------------
68#include "mvsiz_p.inc"
69C-----------------------------------------------
70C C o m m o n B l o c k s
71C-----------------------------------------------
72#include "com08_c.inc"
73#include "sms_c.inc"
74#include "units_c.inc"
75#include "scr07_c.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
80 . IRTLM(2,*), MSR(*), NODNX_SMS(*),
81 . jlt, noint, igap , nsn, nin, igsti, iadm, nradm, intth,
82 . irot, mstr, ifpen(*), ilev, iform,invn
83 INTEGER , INTENT(IN) :: INTFRIC, NRTM
84 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
85 . NSVG(MVSIZ), ITRIA(MVSIZ), NSMS(MVSIZ),ITAB(*)
86 INTEGER , INTENT(IN) :: IPARTFRICS(NSN),IPARTFRICM(NRTM)
87 INTEGER , INTENT(INOUT) :: IPARTFRICSI(MVSIZ),IPARTFRICMI(MVSIZ)
88C REAL
89 my_real
90 . X(3,*), STF(*), STFN(*),GAP_S(*),
91 . XM0(3,*), CSTS(2,*), MS(*), V(3,*), NOD_NORMAL(3,*),
92 . GAP, KMIN, KMAX, GAPMAX, GAPMIN, ANGLT,
93 . RCURV(*), ANGLM(*), RCURVI(MVSIZ), ANGLMI(MVSIZ),
94 . FTXSAV(*), FTYSAV(*), FTZSAV(*),
95 . FXT(MVSIZ), FYT(MVSIZ), FZT(MVSIZ),
96 . GAP_S0(*), AREA_S0(*), GAP0(*), AREA0(*), TEMP(*), TEMPI(*),
97 . XG(3), ROT(9), AS(*), BS(*), PENI(*), DRAD, TINT, TEMPM(*),DEPTH
98C REAL
99 my_real
100 . X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ),
101 . Y1(MVSIZ), Y2(MVSIZ), Y3(MVSIZ), Y4(MVSIZ),
102 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
103 . xi(mvsiz), yi(mvsiz), zi(mvsiz),
104 . nx(mvsiz), ny(mvsiz), nz(mvsiz), pene(mvsiz),
105 . stif(mvsiz) ,gapv(mvsiz),
106 . vxm, vym, vzm,
107 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz), msi(mvsiz),
108 . lb(mvsiz), lc(mvsiz), ls, asi(mvsiz), bsi(mvsiz),
109 . xp(mvsiz), yp(mvsiz), zp(mvsiz),
110 . penrad(*),h1(mvsiz), h2(mvsiz),h3(mvsiz),h4(mvsiz),
111 . dist(mvsiz)
112C-----------------------------------------------
113C L o c a l V a r i a b l e s
114C-----------------------------------------------
115 INTEGER I ,J ,IL, L, IG,JFT, IX, NI,
116 . N1, N2, N3, N4,I1,I2,I3,I4,ND,NG
117 my_real
118 . XT1(MVSIZ), XT2(MVSIZ), XT3(MVSIZ),
119 . YT1(MVSIZ), YT2(MVSIZ), YT3(MVSIZ),
120 . ZT1(MVSIZ), ZT2(MVSIZ), ZT3(MVSIZ),
121 . X0(MVSIZ), Y0(MVSIZ), Z0(MVSIZ),
122 . nx1(mvsiz), nx2(mvsiz), nx3(mvsiz), nx4(mvsiz),
123 . ny1(mvsiz), ny2(mvsiz), ny3(mvsiz), ny4(mvsiz),
124 . nz1(mvsiz), nz2(mvsiz), nz3(mvsiz), nz4(mvsiz),
125 . nx0(mvsiz), ny0(mvsiz), nz0(mvsiz), la(mvsiz),
126 . hx(mvsiz), hy(mvsiz), hz(mvsiz),
127 . nn, hn,temp0 , temp1, temp2, temp3,
128 . temp4,tol,tolfix
129C-----------------------------------------------
130 DO i=1,jlt
131C
132 j=cand_n(i)
133 l=abs(irtlm(1,j))
134C
135 itria(i)=irtlm(2,j)
136C
137 lb(i)=csts(1,j)
138 lc(i)=csts(2,j)
139 la(i) = one-lb(i)-lc(i)
140
141 ix1(i) = irect(1,l)
142 ix2(i) = irect(2,l)
143 ix3(i) = irect(3,l)
144 ix4(i) = irect(4,l)
145
146 ENDDO
147
148 IF(igap==0)THEN
149 DO i=1,jlt
150 gapv(i)=gap
151 ENDDO
152 ELSE
153 DO i=1,jlt
154 gapv(i)=gap_s(cand_n(i))
155 gapv(i)=min(gapv(i),gapmax)
156 gapv(i)=max(gapmin,gapv(i))
157 END DO
158 ENDIF
159C
160 IF(igap==2)THEN
161 DO i=1,jlt
162 gap0(i) =gap_s0(cand_n(i))
163 area0(i)=area_s0(cand_n(i))
164 END DO
165 ELSE
166 DO i=1,jlt
167 area0(i)=area_s0(cand_n(i))
168 END DO
169 END IF
170
171 IF(intth/=0)THEN
172
173C SECONDARY TEMPERATURE
174 DO i=1,jlt
175 ig = nsv(cand_n(i))
176 nsvg(i) = ig
177 tempi(i) = temp(ig)
178 asi(i) = as(cand_n(i))
179 bsi(i) = bs(cand_n(i))
180 END DO
181
182C MAIN TEMPERATURE
183 IF(intth==2)THEN ! Case of MAIN temperature variable over MAIN surface
184
185 DO i=1,jlt
186 i1 = ix1(i)
187 nd = msr(i1)
188 IF(nd > 0) THEN
189 temp1 = temp(nd)
190 ELSE
191 temp1 = nmtemp(nin)%P(-nd)
192 ENDIF
193
194 i2 = ix2(i)
195 nd = msr(i2)
196 IF(nd > 0) THEN
197 temp2 = temp(nd)
198 ELSE
199 temp2 = nmtemp(nin)%P(-nd)
200 ENDIF
201
202 i3 = ix3(i)
203 nd = msr(i3)
204 IF(nd > 0) THEN
205 temp3 = temp(nd)
206 ELSE
207 temp3 = nmtemp(nin)%P(-nd)
208 ENDIF
209
210 i4 = ix4(i)
211 nd = msr(i4)
212 IF(nd > 0) THEN
213 temp4 = temp(nd)
214 ELSE
215 temp4 = nmtemp(nin)%P(-nd)
216 ENDIF
217C
218 IF(ix3(i)/=ix4(i))THEN
219 temp0 = fourth*(temp1+temp2+temp3+temp4)
220 ELSE
221 temp0 = temp3
222 ENDIF
223C
224 IF(itria(i)==1.OR.itria(i)==-1)THEN
225 tempm(i) = lb(i)*temp1+lc(i)*temp2+la(i)*temp0
226 ELSEIF(itria(i)==2.OR.itria(i)==-2)THEN
227 tempm(i) = lb(i)*temp2+lc(i)*temp3+la(i)*temp0
228 ELSEIF(itria(i)==3.OR.itria(i)==-3)THEN
229 tempm(i) = lb(i)*temp3+lc(i)*temp4+la(i)*temp0
230 ELSEIF(itria(i)==4.OR.itria(i)==-4)THEN
231 tempm(i) = lb(i)*temp4+lc(i)*temp1+la(i)*temp0
232 ENDIF
233C
234 END DO
235 ELSE ! Case of MAIN temperature is constant
236 DO i=1,jlt
237 tempm(i) = tint
238 END DO
239 ENDIF
240 END IF
241
242 IF(iform==1)THEN
243 DO i=1,jlt
244 IF(ix3(i)/=ix4(i))THEN
245C
246 IF(itria(i)==1.OR.itria(i)==-1)THEN
247 h1(i) = lb(i) + la(i)/4
248 h2(i) = lc(i) + la(i)/4
249 h3(i) = la(i)/4
250 h4(i) = la(i)/4
251 ELSEIF(itria(i)==2.OR.itria(i)==-2)THEN
252 h2(i) = lb(i) + la(i)/4
253 h3(i) = lc(i) + la(i)/4
254 h1(i) = la(i)/4
255 h4(i) = la(i)/4
256 ELSEIF(itria(i)==3.OR.itria(i)==-3)THEN
257 h3(i) = lb(i) + la(i)/4
258 h4(i) = lc(i) + la(i)/4
259 h1(i) = la(i)/4
260 h2(i) = la(i)/4
261 ELSEIF(itria(i)==4.OR.itria(i)==-4)THEN
262 h4(i) = lb(i) + la(i)/4
263 h1(i) = lc(i) + la(i)/4
264 h2(i) = la(i)/4
265 h3(i) = la(i)/4
266 ENDIF
267C
268 ELSE
269 h1(i) = lb(i)
270 h2(i) = lc(i)
271 h3(i) = la(i)
272 h4(i) = zero
273 ENDIF
274 ENDDO
275 ENDIF
276
277C
278 DO i=1,jlt
279 ig = nsv(cand_n(i))
280 nsvg(i) = ig
281 xi(i) = x(1,ig)
282 yi(i) = x(2,ig)
283 zi(i) = x(3,ig)
284 vxi(i) = v(1,ig)
285 vyi(i) = v(2,ig)
286 vzi(i) = v(3,ig)
287 msi(i)= ms(ig)
288 END DO
289C
290 IF(irot==0)THEN
291 DO i=1,jlt
292C
293 x1(i)=xm0(1,ix1(i))+xg(1)
294 y1(i)=xm0(2,ix1(i))+xg(2)
295 z1(i)=xm0(3,ix1(i))+xg(3)
296C
297 x2(i)=xm0(1,ix2(i))+xg(1)
298 y2(i)=xm0(2,ix2(i))+xg(2)
299 z2(i)=xm0(3,ix2(i))+xg(3)
300C
301 x3(i)=xm0(1,ix3(i))+xg(1)
302 y3(i)=xm0(2,ix3(i))+xg(2)
303 z3(i)=xm0(3,ix3(i))+xg(3)
304C
305 x4(i)=xm0(1,ix4(i))+xg(1)
306 y4(i)=xm0(2,ix4(i))+xg(2)
307 z4(i)=xm0(3,ix4(i))+xg(3)
308C
309 END DO
310C
311 DO i=1,jlt
312C
313 nx1(i)=nod_normal(1,ix1(i))
314 ny1(i)=nod_normal(2,ix1(i))
315 nz1(i)=nod_normal(3,ix1(i))
316C
317 nx2(i)=nod_normal(1,ix2(i))
318 ny2(i)=nod_normal(2,ix2(i))
319 nz2(i)=nod_normal(3,ix2(i))
320C
321 nx3(i)=nod_normal(1,ix3(i))
322 ny3(i)=nod_normal(2,ix3(i))
323 nz3(i)=nod_normal(3,ix3(i))
324C
325 nx4(i)=nod_normal(1,ix4(i))
326 ny4(i)=nod_normal(2,ix4(i))
327 nz4(i)=nod_normal(3,ix4(i))
328C
329 END DO
330C
331 ELSE
332C
333 DO i=1,jlt
334C
335 x1(i)= xg(1)
336 . +rot(1)*xm0(1,ix1(i))
337 . +rot(4)*xm0(2,ix1(i))
338 . +rot(7)*xm0(3,ix1(i))
339 y1(i)= xg(2)
340 . +rot(2)*xm0(1,ix1(i))
341 . +rot(5)*xm0(2,ix1(i))
342 . +rot(8)*xm0(3,ix1(i))
343 z1(i)= xg(3)
344 . +rot(3)*xm0(1,ix1(i))
345 . +rot(6)*xm0(2,ix1(i))
346 . +rot(9)*xm0(3,ix1(i))
347C
348 x2(i)= xg(1)
349 . +rot(1)*xm0(1,ix2(i))
350 . +rot(4)*xm0(2,ix2(i))
351 . +rot(7)*xm0(3,ix2(i))
352 y2(i)= xg(2)
353 . +rot(2)*xm0(1,ix2(i))
354 . +rot(5)*xm0(2,ix2(i))
355 . +rot(8)*xm0(3,ix2(i))
356 z2(i)= xg(3)
357 . +rot(3)*xm0(1,ix2(i))
358 . +rot(6)*xm0(2,ix2(i))
359 . +rot(9)*xm0(3,ix2(i))
360C
361 x3(i)= xg(1)
362 . +rot(1)*xm0(1,ix3(i))
363 . +rot(4)*xm0(2,ix3(i))
364 . +rot(7)*xm0(3,ix3(i))
365 y3(i)= xg(2)
366 . +rot(2)*xm0(1,ix3(i))
367 . +rot(5)*xm0(2,ix3(i))
368 . +rot(8)*xm0(3,ix3(i))
369 z3(i)= xg(3)
370 . +rot(3)*xm0(1,ix3(i))
371 . +rot(6)*xm0(2,ix3(i))
372 . +rot(9)*xm0(3,ix3(i))
373C
374 x4(i)= xg(1)
375 . +rot(1)*xm0(1,ix4(i))
376 . +rot(4)*xm0(2,ix4(i))
377 . +rot(7)*xm0(3,ix4(i))
378 y4(i)= xg(2)
379 . +rot(2)*xm0(1,ix4(i))
380 . +rot(5)*xm0(2,ix4(i))
381 . +rot(8)*xm0(3,ix4(i))
382 z4(i)= xg(3)
383 . +rot(3)*xm0(1,ix4(i))
384 . +rot(6)*xm0(2,ix4(i))
385 . +rot(9)*xm0(3,ix4(i))
386C
387 END DO
388C
389 DO i=1,jlt
390C
391 nx1(i)= rot(1)*nod_normal(1,ix1(i))
392 . +rot(4)*nod_normal(2,ix1(i))
393 . +rot(7)*nod_normal(3,ix1(i))
394 ny1(i)= rot(2)*nod_normal(1,ix1(i))
395 . +rot(5)*nod_normal(2,ix1(i))
396 . +rot(8)*nod_normal(3,ix1(i))
397 nz1(i)= rot(3)*nod_normal(1,ix1(i))
398 . +rot(6)*nod_normal(2,ix1(i))
399 . +rot(9)*nod_normal(3,ix1(i))
400C
401 nx2(i)= rot(1)*nod_normal(1,ix2(i))
402 . +rot(4)*nod_normal(2,ix2(i))
403 . +rot(7)*nod_normal(3,ix2(i))
404 ny2(i)= rot(2)*nod_normal(1,ix2(i))
405 . +rot(5)*nod_normal(2,ix2(i))
406 . +rot(8)*nod_normal(3,ix2(i))
407 nz2(i)= rot(3)*nod_normal(1,ix2(i))
408 . +rot(6)*nod_normal(2,ix2(i))
409 . +rot(9)*nod_normal(3,ix2(i))
410C
411 nx3(i)= rot(1)*nod_normal(1,ix3(i))
412 . +rot(4)*nod_normal(2,ix3(i))
413 . +rot(7)*nod_normal(3,ix3(i))
414 ny3(i)= rot(2)*nod_normal(1,ix3(i))
415 . +rot(5)*nod_normal(2,ix3(i))
416 . +rot(8)*nod_normal(3,ix3(i))
417 nz3(i)= rot(3)*nod_normal(1,ix3(i))
418 . +rot(6)*nod_normal(2,ix3(i))
419 . +rot(9)*nod_normal(3,ix3(i))
420C
421 nx4(i)= rot(1)*nod_normal(1,ix4(i))
422 . +rot(4)*nod_normal(2,ix4(i))
423 . +rot(7)*nod_normal(3,ix4(i))
424 ny4(i)= rot(2)*nod_normal(1,ix4(i))
425 . +rot(5)*nod_normal(2,ix4(i))
426 . +rot(8)*nod_normal(3,ix4(i))
427 nz4(i)= rot(3)*nod_normal(1,ix4(i))
428 . +rot(6)*nod_normal(2,ix4(i))
429 . +rot(9)*nod_normal(3,ix4(i))
430C
431 END DO
432C
433 END IF
434C
435 DO i=1,jlt
436 IF(ix3(i)/=ix4(i))THEN
437 x0(i) = fourth*(x1(i)+x2(i)+x3(i)+x4(i))
438 y0(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
439 z0(i) = fourth*(z1(i)+z2(i)+z3(i)+z4(i))
440 nx0(i)= fourth*(nx1(i)+nx2(i)+nx3(i)+nx4(i))
441 ny0(i)= fourth*(ny1(i)+ny2(i)+ny3(i)+ny4(i))
442 nz0(i)= fourth*(nz1(i)+nz2(i)+nz3(i)+nz4(i))
443 ELSE
444 x0(i) = x3(i)
445 y0(i) = y3(i)
446 z0(i) = z3(i)
447 nx0(i)= nx3(i)
448 ny0(i)= ny3(i)
449 nz0(i)= nz3(i)
450 ENDIF
451 ENDDO
452C
453 DO i=1,jlt
454C
455 IF(itria(i)==1.OR.itria(i)==-1)THEN
456 xt1(i)=x1(i)
457 yt1(i)=y1(i)
458 zt1(i)=z1(i)
459 xt2(i)=x2(i)
460 yt2(i)=y2(i)
461 zt2(i)=z2(i)
462 xt3(i)=x0(i)
463 yt3(i)=y0(i)
464 zt3(i)=z0(i)
465 nx(i)=lb(i)*nx1(i)+lc(i)*nx2(i)+la(i)*nx0(i)
466 ny(i)=lb(i)*ny1(i)+lc(i)*ny2(i)+la(i)*ny0(i)
467 nz(i)=lb(i)*nz1(i)+lc(i)*nz2(i)+la(i)*nz0(i)
468 ELSEIF(itria(i)==2.OR.itria(i)==-2)THEN
469 xt1(i)=x2(i)
470 yt1(i)=y2(i)
471 zt1(i)=z2(i)
472 xt2(i)=x3(i)
473 yt2(i)=y3(i)
474 zt2(i)=z3(i)
475 xt3(i)=x0(i)
476 yt3(i)=y0(i)
477 zt3(i)=z0(i)
478 nx(i)=lb(i)*nx2(i)+lc(i)*nx3(i)+la(i)*nx0(i)
479 ny(i)=lb(i)*ny2(i)+lc(i)*ny3(i)+la(i)*ny0(i)
480 nz(i)=lb(i)*nz2(i)+lc(i)*nz3(i)+la(i)*nz0(i)
481 ELSEIF(itria(i)==3.OR.itria(i)==-3)THEN
482 xt1(i)=x3(i)
483 yt1(i)=y3(i)
484 zt1(i)=z3(i)
485 xt2(i)=x4(i)
486 yt2(i)=y4(i)
487 zt2(i)=z4(i)
488 xt3(i)=x0(i)
489 yt3(i)=y0(i)
490 zt3(i)=z0(i)
491 nx(i)=lb(i)*nx3(i)+lc(i)*nx4(i)+la(i)*nx0(i)
492 ny(i)=lb(i)*ny3(i)+lc(i)*ny4(i)+la(i)*ny0(i)
493 nz(i)=lb(i)*nz3(i)+lc(i)*nz4(i)+la(i)*nz0(i)
494 ELSEIF(itria(i)==4.OR.itria(i)==-4)THEN
495 xt1(i)=x4(i)
496 yt1(i)=y4(i)
497 zt1(i)=z4(i)
498 xt2(i)=x1(i)
499 yt2(i)=y1(i)
500 zt2(i)=z1(i)
501 xt3(i)=x0(i)
502 yt3(i)=y0(i)
503 zt3(i)=z0(i)
504 nx(i)=lb(i)*nx4(i)+lc(i)*nx1(i)+la(i)*nx0(i)
505 ny(i)=lb(i)*ny4(i)+lc(i)*ny1(i)+la(i)*ny0(i)
506 nz(i)=lb(i)*nz4(i)+lc(i)*nz1(i)+la(i)*nz0(i)
507 END IF
508C
509 ENDDO
510C
511 DO i=1,jlt
512
513C3 pas la meme distance que dans i21dst3 : DIST <= Pi(I)
514c LB(I) = MIN(ONE,MAX(LB(I),ZERO))
515c LC(I) = MIN(ONE,MAX(LC(I),ZERO))
516c LA(I) = MIN(ONE,MAX(LA(I),ZERO))
517c LS=ONE/MAX(EM20,LA(I)+LB(I)+LC(I))
518c LB(I) = LB(I)*LS
519c LC(I) = LC(I)*LS
520c LA(I) = LA(I)*LS
521
522 xp(i)=(lb(i)*xt1(i)+lc(i)*xt2(i)+la(i)*xt3(i))
523 yp(i)=(lb(i)*yt1(i)+lc(i)*yt2(i)+la(i)*yt3(i))
524 zp(i)=(lb(i)*zt1(i)+lc(i)*zt2(i)+la(i)*zt3(i))
525
526 hx(i)=xi(i)-xp(i)
527 hy(i)=yi(i)-yp(i)
528 hz(i)=zi(i)-zp(i)
529
530 hn =hx(i)*nx(i)+hy(i)*ny(i)+hz(i)*nz(i)
531 nx(i)=hx(i)*sign(one,hn)
532 ny(i)=hy(i)*sign(one,hn)
533 nz(i)=hz(i)*sign(one,hn)
534
535 dist(i)=sqrt(nx(i)*nx(i)+ny(i)*ny(i)+nz(i)*nz(i))
536 nn=one/max(em20,dist(i))
537 nx(i)=nx(i)*nn
538 ny(i)=ny(i)*nn
539 nz(i)=nz(i)*nn
540
541 dist(i)=dist(i)*sign(one,hn)
542C3 DIST <= GAPV(I) a la precision machine pres.
543 pene(i)=max(zero,gapv(i)-dist(i))
544 ENDDO
545
546
547C
548 DO i=1,jlt
549 l = cand_e(i)
550 stif(i)=stf(l)*abs(stfn(cand_n(i)))
551 ENDDO
552C
553 IF(intth/=0)THEN
554 DO i=1,jlt
555 l = cand_e(i)
556C PENRAD mesure si Gap < Dist < Dradiation
557 penrad(i)=dist(i)-gapv(i)
558C Out of the gap (Gap < dist < Dradiation)
559 ENDDO
560 END IF
561C
562C----Friction model : secnd part IDs---------
563 IF(intfric > 0) THEN
564 DO i=1,jlt
565 ni = cand_n(i)
566 l = cand_e(i)
567 ipartfricsi(i)= ipartfrics(ni)
568 ipartfricmi(i) = ipartfricm(l)
569C
570 ENDDO
571 ENDIF
572C---------------------
573C PENE INITIALE
574C---------------------
575 IF(ilev==0)THEN
576 IF(tt/=zero)THEN
577 DO i=1,jlt
578 IF(pene(i)==zero)THEN
579 ftxsav(cand_n(i))=zero
580 ftysav(cand_n(i))=zero
581 ftzsav(cand_n(i))=zero
582 peni(cand_n(i)) =zero
583 ifpen(cand_n(i)) =0
584 END IF
585 END DO
586 END IF
587 ELSEIF(tt/=zero)THEN
588 DO i=1,jlt
589 IF(pene(i)==zero)THEN
590 ftxsav(cand_n(i))=zero
591 ftysav(cand_n(i))=zero
592 ftzsav(cand_n(i))=zero
593 peni(cand_n(i)) =zero
594 ifpen(cand_n(i)) =0
595 ELSEIF(ifpen(cand_n(i))==1)THEN
596C no force but viscosity at 1st impact
597C (due to possible impact from the rear)
598 peni(cand_n(i)) =pene(i)
599 END IF
600 END DO
601 END IF
602C
603 IF(invn > 0) THEN
604 tolfix = (one-em02)*depth
605 DO i=1,jlt
606 tol = gapv(i) + tolfix
607 IF(ifpen(cand_n(i))==1)THEN
608C check if penetrations are important at 1st impact => detect if normals are inverted GAPV+DEPTH-0.01*DEPTH <= PENE <= GAPV+DEPTH
609 IF(pene(i)>tol.AND.stif(i)>zero) THEN
610#include "lockon.inc"
611 WRITE(iout,'(A,I10,A)')
612 . ' **CONTACT PROBLEM IN INTERFACE ',noint,'**'
613 WRITE(istdo,'(A)')'The run encountered a problem in an in
614 .terface Type 21.'
615 WRITE(istdo,'(A)')'Maximum penetration is reached'
616 WRITE(istdo,'(A)')'You may need to check if contact normals
617 .of tools are oriented toward the blank,'
618 WRITE(iout, '(A)')'The run encountered a problem in an in
619 .terface Type 21.'
620 WRITE(iout, '(A)')'Maximum penetration is reached'
621 WRITE(iout, '(A)')'You may need to check if contact normals
622 .of tools are oriented toward the blank,'
623
624 ng = nsvg(i)
625 ni = itab(ng)
626
627 WRITE(iout,'(A,I10)') ' SECONDARY NODE : ',ni
628 WRITE(iout,'(A,4I10)')' MAIN NODES : ',
629 . itab(ix1(i)),itab(ix2(i)),itab(ix3(i)),itab(ix4(i))
630#include "lockoff.inc"
631c TSTOP = TT
632
633 mstop = 2
634 ENDIF
635 ENDIF
636 ENDDO
637 ENDIF
638C
639 DO i=1,jlt
640 fxt(i)=ftxsav(cand_n(i))
641 fyt(i)=ftysav(cand_n(i))
642 fzt(i)=ftzsav(cand_n(i))
643 END DO
644C
645 IF(iadm/=0)THEN
646 DO i=1,jlt
647 l = cand_e(i)
648 rcurvi(i)=rcurv(l)/nradm
649 anglmi(i)=anglm(l)/max(em20,anglt)
650 END DO
651 END IF
652C
653 IF(idtmins==2)THEN
654 DO i=1,jlt
655 nsms(i)=nodnx_sms(nsvg(i))+nodnx_sms(mstr)
656 ENDDO
657 IF(idtmins_int/=0)THEN
658 DO i=1,jlt
659 IF(nsms(i)==0)nsms(i)=-1
660 ENDDO
661 END IF
662 ELSEIF(idtmins_int/=0)THEN
663 DO i=1,jlt
664 nsms(i)=-1
665 ENDDO
666 ENDIF
667
668 RETURN
669 END
670
i21cor3
subroutine i21cor3(jlt, nin, x, irect, nsn, nsv, cand_e, cand_n, stf, stfn, xm0, nod_normal, irtlm, csts, msr, ms, v, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, igsti, stif, kmin, kmax, igap, gap, gap_s, gapv, gapmax, gapmin, nx, ny, nz, pene, vxm, vym, vzm, vxi, vyi, vzi, msi, itria, lb, lc, iadm, rcurv, anglm, nradm, anglt, rcurvi, anglmi, fxt, fyt, fzt, ftxsav, ftysav, ftzsav, gap_s0, area_s0, gap0, area0, intth, temp, tempi, irot, xg, rot, as, bs, asi, bsi, xp, yp, zp, nodnx_sms, nsms, mstr, peni, ifpen, ilev, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, drad, penrad, tint, tempm, iform, h1, h2, h3, h4, dist, itab, noint, depth, invn, intfric, ipartfrics, ipartfricsi, ipartfricm, ipartfricmi, nrtm)
Definition i21cor3.F:55
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
intstamp_glob_mod
Definition intstamp_glob_mod.F:30
intstamp_glob_mod::nmtemp
type(real_pointer), dimension(:), allocatable nmtemp
Definition intstamp_glob_mod.F:76