OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25cor3.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!|| i25cor3_1 ../engine/source/interfaces/int25/i25cor3.F
25!||--- called by ------------------------------------------------------
26!|| i25comp_1 ../engine/source/interfaces/int25/i25comp_1.F
27!||--- uses -----------------------------------------------------
28!|| tri7box ../engine/share/modules/tri7box.F
29!||====================================================================
30 SUBROUTINE i25cor3_1(
31 1 JLT ,X ,IRECT ,NSV ,CAND_E ,
32 2 CAND_N ,IRTLM ,STF ,STFN ,STIF ,
33 3 IGAP ,XI ,YI ,ZI ,
34 4 IX1 ,IX2 ,IX3 ,IX4 ,
35 5 NSVG ,NSN ,
36 6 NIN ,GAP_S ,GAPS ,ADMSR ,NOD_NORMAL ,
37 7 XX ,YY ,ZZ ,
38 8 NNX ,NNY ,NNZ ,
39 9 GAP_M ,GAPM ,GAPN_M ,GAPNM ,SUBTRIA ,
40 A MVOISIN ,MVOISN ,GAP_S_L,GAP_M_L,GAPMXL ,
41 B LBOUND ,IBOUND )
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE tri7box
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER JLT, NSN, NIN, IGAP,
58 . IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*), IRTLM(4,NSN)
59 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
60 . NSVG(MVSIZ), ADMSR(4,*), SUBTRIA(MVSIZ),
61 . MVOISIN(4,*), MVOISN(MVSIZ,4), LBOUND(*), IBOUND(4,MVSIZ)
62C REAL
63 my_real
64 . X(3,*), STF(*), STFN(*), GAP_S(*),
65 . GAPS(MVSIZ), GAP_M(*), GAPM(*), GAPN_M(4,*), GAPNM(4,*),
66 . GAP_S_L(*), GAP_M_L(*), GAPMXL(*)
67C REAL
68 my_real
69 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
70 . xx(mvsiz,5), yy(mvsiz,5), zz(mvsiz,5),
71 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5)
72 real*4 nod_normal(3,4,*)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I ,J , L, NN, IG, JFT, IX, NI, I1, I2, I3, I4
77 my_real
78 . XN
79C-----------------------------------------------
80 DO i=1,jlt
81 ni = cand_n(i)
82 IF(ni<=nsn)THEN
83 ig = nsv(ni)
84 nsvg(i) = ig
85 xi(i) = x(1,ig)
86 yi(i) = x(2,ig)
87 zi(i) = x(3,ig)
88 gaps(i) = gap_s(ni)
89 ELSE
90 nn = ni - nsn
91 nsvg(i) = -nn
92 xi(i) = xfi(nin)%P(1,nn)
93 yi(i) = xfi(nin)%P(2,nn)
94 zi(i) = xfi(nin)%P(3,nn)
95 gaps(i) = gapfi(nin)%P(nn)
96 END IF
97 END DO
98C
99 DO i=1,jlt
100C
101 l = cand_e(i)
102C
103 ix=irect(1,l)
104 ix1(i)=ix
105 xx(i,1)=x(1,ix)
106 yy(i,1)=x(2,ix)
107 zz(i,1)=x(3,ix)
108C
109 ix=irect(2,l)
110 ix2(i)=ix
111 xx(i,2)=x(1,ix)
112 yy(i,2)=x(2,ix)
113 zz(i,2)=x(3,ix)
114C
115 ix=irect(3,l)
116 ix3(i)=ix
117 xx(i,3)=x(1,ix)
118 yy(i,3)=x(2,ix)
119 zz(i,3)=x(3,ix)
120C
121 ix=irect(4,l)
122 ix4(i)=ix
123 xx(i,4)=x(1,ix)
124 yy(i,4)=x(2,ix)
125 zz(i,4)=x(3,ix)
126C
127 gapm(i) =gap_m(l)
128 gapnm(1:4,i)=gapn_m(1:4,l)
129C
130 END DO
131C
132 IF(igap/=3)THEN
133 gapmxl(1:jlt)=ep30
134 ELSE
135 DO i=1,jlt
136 ni = cand_n(i)
137 l = cand_e(i)
138 IF(ni<=nsn)THEN
139 gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
140 ELSE
141 gapmxl(i)=gap_lfi(nin)%P(ni-nsn)+gap_m_l(l)
142 END IF
143 END DO
144 END IF
145C
146 DO i=1,jlt
147C
148 IF(ix3(i) /= ix4(i))THEN
149 xx(i,5)= fourth*(xx(i,1)+xx(i,2)+xx(i,3)+xx(i,4))
150 yy(i,5)= fourth*(yy(i,1)+yy(i,2)+yy(i,3)+yy(i,4))
151 zz(i,5)= fourth*(zz(i,1)+zz(i,2)+zz(i,3)+zz(i,4))
152 ELSE
153 xx(i,5)= xx(i,3)
154 yy(i,5)= yy(i,3)
155 zz(i,5)= zz(i,3)
156 ENDIF
157C
158 END DO
159C
160 DO i=1,jlt
161C
162 l = cand_e(i)
163C
164 nnx(i,1)=nod_normal(1,1,l)
165 nny(i,1)=nod_normal(2,1,l)
166 nnz(i,1)=nod_normal(3,1,l)
167C
168 nnx(i,2)=nod_normal(1,2,l)
169 nny(i,2)=nod_normal(2,2,l)
170 nnz(i,2)=nod_normal(3,2,l)
171C
172 nnx(i,3)=nod_normal(1,3,l)
173 nny(i,3)=nod_normal(2,3,l)
174 nnz(i,3)=nod_normal(3,3,l)
175C
176 nnx(i,4)=nod_normal(1,4,l)
177 nny(i,4)=nod_normal(2,4,l)
178 nnz(i,4)=nod_normal(3,4,l)
179C
180 END DO
181C
182 DO i=1,jlt
183 IF(ix3(i)/=ix4(i))THEN
184 nnx(i,5)=fourth*(nnx(i,1)+nnx(i,2)+nnx(i,3)+nnx(i,4))
185 nny(i,5)=fourth*(nny(i,1)+nny(i,2)+nny(i,3)+nny(i,4))
186 nnz(i,5)=fourth*(nnz(i,1)+nnz(i,2)+nnz(i,3)+nnz(i,4))
187 ELSE
188 nnx(i,5)=nnx(i,4)
189 nny(i,5)=nny(i,4)
190 nnz(i,5)=nnz(i,4)
191 ENDIF
192 xn=one/max(em20,sqrt(nnx(i,5)*nnx(i,5)+nny(i,5)*nny(i,5)+nnz(i,5)*nnz(i,5)))
193 nnx(i,5)=xn*nnx(i,5)
194 nny(i,5)=xn*nny(i,5)
195 nnz(i,5)=xn*nnz(i,5)
196 END DO
197C
198 DO i=1,jlt
199 l = cand_e(i)
200 ni = cand_n(i)
201 IF(ni<=nsn)THEN
202 stif(i)=stf(l)*abs(stfn(ni))
203 ELSE
204 nn = ni - nsn
205 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
206 END IF
207C
208 IF(ni <= nsn)THEN
209 subtria(i) = mod(irtlm(2,ni),5)
210 ELSE
211 subtria(i) = mod(irtlm_fi(nin)%P(2,ni-nsn),5)
212 END IF
213 IF(subtria(i) < 0) subtria(i)=-subtria(i)
214 ENDDO
215C
216 ibound(1:4,1:jlt)=0
217 DO i=1,jlt
218 l = cand_e(i)
219 DO j=1,4
220 mvoisn(i,j)=mvoisin(j,l)
221 IF(lbound(admsr(j,l))/=0)ibound(j,i)=admsr(j,l)
222 END DO
223 END DO
224C
225 RETURN
226 END
227!||====================================================================
228!|| i25cor3_21 ../engine/source/interfaces/int25/i25cor3.F
229!||--- called by ------------------------------------------------------
230!|| i25comp_2 ../engine/source/interfaces/int25/i25comp_2.F
231!||--- uses -----------------------------------------------------
232!|| tri7box ../engine/share/modules/tri7box.F
233!||====================================================================
234 SUBROUTINE i25cor3_21(
235 1 JLT ,X ,IRECT ,NSV ,CAND_E ,
236 2 CAND_N ,STF ,STFN ,STIF ,IGAP ,
237 3 XI ,YI ,ZI ,IX1 ,IX2 ,
238 4 IX3 ,IX4 ,NSVG ,NSN ,MSEGTYP ,
239 5 ETYP ,NIN ,GAP_S ,GAPS ,ADMSR ,
240 6 NOD_NORMAL ,XX ,YY ,ZZ ,NNX ,
241 7 NNY ,NNZ ,GAP_M ,GAPM ,GAPN_M ,
242 8 GAPNM ,ISLIDE ,KSLIDE,MVOISIN ,MVOISN ,
243 9 GAP_S_L,GAP_M_L ,GAPMXL,LBOUND ,IBOUND )
244C-----------------------------------------------
245C M o d u l e s
246C-----------------------------------------------
247 USE tri7box
248C-----------------------------------------------
249C I m p l i c i t T y p e s
250C-----------------------------------------------
251#include "implicit_f.inc"
252C-----------------------------------------------
253C G l o b a l P a r a m e t e r s
254C-----------------------------------------------
255#include "mvsiz_p.inc"
256C-----------------------------------------------
257C D u m m y A r g u m e n t s
258C-----------------------------------------------
259 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*), MSEGTYP(*),
260 . JLT, NSN, NIN, IGAP
261 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
262 . NSVG(MVSIZ), ADMSR(4,*), ISLIDE(4,*), KSLIDE(MVSIZ,4),
263 . MVOISIN(4,*), MVOISN(MVSIZ,4), LBOUND(*), IBOUND(4,MVSIZ), ETYP(MVSIZ)
264C REAL
265 my_real
266 . X(3,*), STF(*), STFN(*), GAP_S(*),
267 . gaps(mvsiz), gap_m(*), gapm(*), gapn_m(4,*), gapnm(4,*),
268 . gap_s_l(*), gap_m_l(*), gapmxl(*)
269C REAL
270 my_real
271 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
272 . xx(mvsiz,5), yy(mvsiz,5), zz(mvsiz,5),
273 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5)
274 real*4 nod_normal(3,4,*)
275C-----------------------------------------------
276C L o c a l V a r i a b l e s
277C-----------------------------------------------
278 INTEGER I ,J , K, L, NN, IG, JFT, IX, NI, I1, I2, I3, I4, NOR, II(4)
279 my_real
280 . xn
281C-----------------------------------------------
282 DO i=1,jlt
283 ni = cand_n(i)
284 IF(ni<=nsn)THEN
285 ig = nsv(ni)
286 nsvg(i) = ig
287 xi(i) = x(1,ig)
288 yi(i) = x(2,ig)
289 zi(i) = x(3,ig)
290 gaps(i) = gap_s(ni)
291 ELSE
292 nn = ni - nsn
293 nsvg(i) = -nn
294 xi(i) = xfi(nin)%P(1,nn)
295 yi(i) = xfi(nin)%P(2,nn)
296 zi(i) = xfi(nin)%P(3,nn)
297 gaps(i) = gapfi(nin)%P(nn)
298 END IF
299 END DO
300C
301 DO i=1,jlt
302C
303 l = cand_e(i)
304 etyp(i) =msegtyp(l)
305C
306 ix=irect(1,l)
307 ix1(i)=ix
308 xx(i,1)=x(1,ix)
309 yy(i,1)=x(2,ix)
310 zz(i,1)=x(3,ix)
311C
312 ix=irect(2,l)
313 ix2(i)=ix
314 xx(i,2)=x(1,ix)
315 yy(i,2)=x(2,ix)
316 zz(i,2)=x(3,ix)
317C
318 ix=irect(3,l)
319 ix3(i)=ix
320 xx(i,3)=x(1,ix)
321 yy(i,3)=x(2,ix)
322 zz(i,3)=x(3,ix)
323C
324 ix=irect(4,l)
325 ix4(i)=ix
326 xx(i,4)=x(1,ix)
327 yy(i,4)=x(2,ix)
328 zz(i,4)=x(3,ix)
329C
330 gapm(i) =gap_m(l)
331 gapnm(1:4,i)=gapn_m(1:4,l)
332C
333 END DO
334C
335 IF(igap/=3)THEN
336 gapmxl(1:jlt)=ep30
337 ELSE
338 DO i=1,jlt
339 ni = cand_n(i)
340 l = cand_e(i)
341 IF(ni<=nsn)THEN
342 gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
343 ELSE
344 gapmxl(i)=gap_lfi(nin)%P(ni-nsn)+gap_m_l(l)
345 END IF
346 END DO
347 END IF
348C
349 DO i=1,jlt
350C
351 IF(ix3(i) /= ix4(i))THEN
352 xx(i,5)= fourth*(xx(i,1)+xx(i,2)+xx(i,3)+xx(i,4))
353 yy(i,5)= fourth*(yy(i,1)+yy(i,2)+yy(i,3)+yy(i,4))
354 zz(i,5)= fourth*(zz(i,1)+zz(i,2)+zz(i,3)+zz(i,4))
355 ELSE
356 xx(i,5)= xx(i,3)
357 yy(i,5)= yy(i,3)
358 zz(i,5)= zz(i,3)
359 ENDIF
360C
361 END DO
362C
363 DO i=1,jlt
364C
365 l = cand_e(i)
366C
367 nnx(i,1)=nod_normal(1,1,l)
368 nny(i,1)=nod_normal(2,1,l)
369 nnz(i,1)=nod_normal(3,1,l)
370C
371 nnx(i,2)=nod_normal(1,2,l)
372 nny(i,2)=nod_normal(2,2,l)
373 nnz(i,2)=nod_normal(3,2,l)
374C
375 nnx(i,3)=nod_normal(1,3,l)
376 nny(i,3)=nod_normal(2,3,l)
377 nnz(i,3)=nod_normal(3,3,l)
378C
379 nnx(i,4)=nod_normal(1,4,l)
380 nny(i,4)=nod_normal(2,4,l)
381 nnz(i,4)=nod_normal(3,4,l)
382C
383 END DO
384C
385 DO i=1,jlt
386 IF(ix3(i)/=ix4(i))THEN
387 nnx(i,5)=fourth*(nnx(i,1)+nnx(i,2)+nnx(i,3)+nnx(i,4))
388 nny(i,5)=fourth*(nny(i,1)+nny(i,2)+nny(i,3)+nny(i,4))
389 nnz(i,5)=fourth*(nnz(i,1)+nnz(i,2)+nnz(i,3)+nnz(i,4))
390 ELSE
391 nnx(i,5)=nnx(i,4)
392 nny(i,5)=nny(i,4)
393 nnz(i,5)=nnz(i,4)
394 ENDIF
395 xn=one/max(em20,sqrt(nnx(i,5)*nnx(i,5)+nny(i,5)*nny(i,5)+nnz(i,5)*nnz(i,5)))
396 nnx(i,5)=xn*nnx(i,5)
397 nny(i,5)=xn*nny(i,5)
398 nnz(i,5)=xn*nnz(i,5)
399 END DO
400C
401 DO i=1,jlt
402 l = cand_e(i)
403 ni = cand_n(i)
404 IF(ni<=nsn)THEN
405 stif(i)=stf(l)*abs(stfn(ni))
406 ELSE
407 nn = ni - nsn
408 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
409 END IF
410 ENDDO
411C
412 kslide(1:mvsiz,1:4)=0
413 ibound(1:4,1:jlt)=0
414 DO i=1,jlt
415C
416 ni = cand_n(i)
417 l = cand_e(i)
418 ii(1)=abs(admsr(1,l))
419 ii(2)=abs(admsr(2,l))
420 ii(3)=abs(admsr(3,l))
421 ii(4)=abs(admsr(4,l))
422 DO j=1,4
423 mvoisn(i,j)=mvoisin(j,l)
424
425 IF(ni<=nsn)THEN
426 nor=islide(j,ni)
427 ELSE
428 nn = ni - nsn
429 nor=islide_fi(nin)%P(j,nn)
430 END IF
431
432 if(nor < 0) print *,'i25cor3-2 internal error'
433
434 IF(nor/=0)THEN
435 DO k=1,4
436 IF(nor==ii(k))THEN
437 kslide(i,k)=1
438 EXIT
439 END IF
440 END DO
441 END IF
442
443 IF(lbound(admsr(j,l))/=0)ibound(j,i)=admsr(j,l)
444 END DO
445 END DO
446C
447 RETURN
448 END
449!||====================================================================
450!|| i25cor3_22 ../engine/source/interfaces/int25/i25cor3.F
451!||--- called by ------------------------------------------------------
452!|| i25comp_2 ../engine/source/interfaces/int25/i25comp_2.F
453!||--- uses -----------------------------------------------------
454!|| tri7box ../engine/share/modules/tri7box.F
455!||====================================================================
456 SUBROUTINE i25cor3_22(
457 1 JLT ,X ,IRECT ,NSV ,CAND_E ,
458 2 CAND_N ,STF ,STFN ,STIF ,IGAP ,
459 3 XI ,YI ,ZI ,VXI ,VYI ,
460 4 VZI ,IX1 ,IX2 ,IX3 ,IX4 ,
461 5 NSVG ,NSN ,V ,
462 6 NIN ,GAP_S ,GAPS ,ADMSR ,NOD_NORMAL ,
463 7 XX ,YY ,ZZ ,
464 C VX1 ,VX2 ,VX3 ,VX4 ,
465 D VY1 ,VY2 ,VY3 ,VY4 ,
466 E VZ1 ,VZ2 ,VZ3 ,VZ4 ,
467 E NAX ,NAY ,NAZ ,
468 E NBX ,NBY ,NBZ ,
469 J GAP_M ,GAPM ,GAPN_M ,GAPNM ,
470 L MVOISIN ,NRTM ,MSEGTYP ,ISHEL ,
471 P MVOISA ,MVOISB,GAP_S_L,GAP_M_L,GAPMXL ,
472 Q LBOUND ,IBOUNDA,IBOUNDB)
473C-----------------------------------------------
474C M o d u l e s
475C-----------------------------------------------
476 USE tri7box
477C-----------------------------------------------
478C I m p l i c i t T y p e s
479C-----------------------------------------------
480#include "implicit_f.inc"
481C-----------------------------------------------
482C G l o b a l P a r a m e t e r s
483C-----------------------------------------------
484#include "mvsiz_p.inc"
485C-----------------------------------------------
486C D u m m y A r g u m e n t s
487C-----------------------------------------------
488 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
489 . JLT, NSN, NIN, NRTM, IGAP, MSEGTYP(*), ISHEL(MVSIZ)
490 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
491 . NSVG(MVSIZ), ADMSR(4,*),
492 . mvoisin(4,*), mvoisa(mvsiz,4), mvoisb(mvsiz,4),
493 . lbound(*),ibounda(4,mvsiz),iboundb(4,mvsiz)
494C REAL
495 my_real
496 . x(3,*), stf(*), stfn(*), v(3,*), gap_s(*),
497 . gaps(mvsiz), gap_m(*), gapm(*), gapn_m(4,*), gapnm(4,*),
498 . gap_s_l(*), gap_m_l(*), gapmxl(*)
499C REAL
500 my_real
501 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
502 . xx(mvsiz,5), yy(mvsiz,5), zz(mvsiz,5),
503 . vx1(mvsiz),vy1(mvsiz),vz1(mvsiz),
504 . vx2(mvsiz),vy2(mvsiz),vz2(mvsiz),
505 . vx3(mvsiz),vy3(mvsiz),vz3(mvsiz),
506 . vx4(mvsiz),vy4(mvsiz),vz4(mvsiz),
507 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz),
508 . nax(mvsiz,5), nay(mvsiz,5), naz(mvsiz,5),
509 . nbx(mvsiz,5), nby(mvsiz,5), nbz(mvsiz,5)
510 real*4 nod_normal(3,4,*)
511C-----------------------------------------------
512C L o c a l V a r i a b l e s
513C-----------------------------------------------
514 INTEGER I ,J , K, L, NN, IG, JFT, IX, NI, I1, I2, I3, I4, NOR, II(4), ISH
515 my_real
516 . XN
517C-----------------------------------------------
518 DO I=1,jlt
519 ni = cand_n(i)
520 IF(ni<=nsn)THEN
521 ig = nsv(ni)
522 nsvg(i) = ig
523 xi(i) = x(1,ig)
524 yi(i) = x(2,ig)
525 zi(i) = x(3,ig)
526 vxi(i) = v(1,ig)
527 vyi(i) = v(2,ig)
528 vzi(i) = v(3,ig)
529 gaps(i) = gap_s(ni)
530 ELSE
531 nn = ni - nsn
532 nsvg(i) = -nn
533 xi(i) = xfi(nin)%P(1,nn)
534 yi(i) = xfi(nin)%P(2,nn)
535 zi(i) = xfi(nin)%P(3,nn)
536 vxi(i)= vfi(nin)%P(1,nn)
537 vyi(i)= vfi(nin)%P(2,nn)
538 vzi(i)= vfi(nin)%P(3,nn)
539 gaps(i) = gapfi(nin)%P(nn)
540 END IF
541 END DO
542C
543 ishel(1:mvsiz)=0
544 DO i=1,jlt
545C
546 l = cand_e(i)
547C
548 ix=irect(1,l)
549 ix1(i)=ix
550 xx(i,1)=x(1,ix)
551 yy(i,1)=x(2,ix)
552 zz(i,1)=x(3,ix)
553 vx1(i)=v(1,ix)
554 vy1(i)=v(2,ix)
555 vz1(i)=v(3,ix)
556C
557 ix=irect(2,l)
558 ix2(i)=ix
559 xx(i,2)=x(1,ix)
560 yy(i,2)=x(2,ix)
561 zz(i,2)=x(3,ix)
562 vx2(i)=v(1,ix)
563 vy2(i)=v(2,ix)
564 vz2(i)=v(3,ix)
565C
566 ix=irect(3,l)
567 ix3(i)=ix
568 xx(i,3)=x(1,ix)
569 yy(i,3)=x(2,ix)
570 zz(i,3)=x(3,ix)
571 vx3(i)=v(1,ix)
572 vy3(i)=v(2,ix)
573 vz3(i)=v(3,ix)
574C
575 ix=irect(4,l)
576 ix4(i)=ix
577 xx(i,4)=x(1,ix)
578 yy(i,4)=x(2,ix)
579 zz(i,4)=x(3,ix)
580 vx4(i)=v(1,ix)
581 vy4(i)=v(2,ix)
582 vz4(i)=v(3,ix)
583C
584 gapm(i) =gap_m(l)
585 gapnm(1:4,i)=gapn_m(1:4,l)
586C
587 ish=msegtyp(l)
588 IF(ish > 0) THEN
589 IF(ish > nrtm)ish=ish-nrtm
590 ishel(i)=ish
591 END IF
592C
593 END DO
594C
595 IF(igap/=3)THEN
596 gapmxl(1:jlt)=ep30
597 ELSE
598 DO i=1,jlt
599 ni = cand_n(i)
600 l = cand_e(i)
601 IF(ni<=nsn)THEN
602 gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
603 ELSE
604 gapmxl(i)=gap_lfi(nin)%P(ni-nsn)+gap_m_l(l)
605 END IF
606 END DO
607 END IF
608C
609 DO i=1,jlt
610C
611 IF(ix3(i) /= ix4(i))THEN
612 xx(i,5)= fourth*(xx(i,1)+xx(i,2)+xx(i,3)+xx(i,4))
613 yy(i,5)= fourth*(yy(i,1)+yy(i,2)+yy(i,3)+yy(i,4))
614 zz(i,5)= fourth*(zz(i,1)+zz(i,2)+zz(i,3)+zz(i,4))
615 ELSE
616 xx(i,5)= xx(i,3)
617 yy(i,5)= yy(i,3)
618 zz(i,5)= zz(i,3)
619 ENDIF
620C
621 END DO
622C
623 DO i=1,jlt
624C
625 l = cand_e(i)
626C
627 nax(i,1)=nod_normal(1,1,l)
628 nay(i,1)=nod_normal(2,1,l)
629 naz(i,1)=nod_normal(3,1,l)
630C
631 nax(i,2)=nod_normal(1,2,l)
632 nay(i,2)=nod_normal(2,2,l)
633 naz(i,2)=nod_normal(3,2,l)
634C
635 nax(i,3)=nod_normal(1,3,l)
636 nay(i,3)=nod_normal(2,3,l)
637 naz(i,3)=nod_normal(3,3,l)
638C
639 nax(i,4)=nod_normal(1,4,l)
640 nay(i,4)=nod_normal(2,4,l)
641 naz(i,4)=nod_normal(3,4,l)
642C
643 END DO
644C
645 DO i=1,jlt
646 IF(ix3(i)/=ix4(i))THEN
647 nax(i,5)= fourth*(nax(i,1)+nax(i,2)+nax(i,3)+nax(i,4))
648 nay(i,5)= fourth*(nay(i,1)+nay(i,2)+nay(i,3)+nay(i,4))
649 naz(i,5)= fourth*(naz(i,1)+naz(i,2)+naz(i,3)+naz(i,4))
650 ELSE
651 nax(i,5)= nax(i,4)
652 nay(i,5)= nay(i,4)
653 naz(i,5)= naz(i,4)
654 ENDIF
655 xn=one/max(em20,sqrt(nax(i,5)*nax(i,5)+nay(i,5)*nay(i,5)+naz(i,5)*naz(i,5)))
656 nax(i,5)=xn*nax(i,5)
657 nay(i,5)=xn*nay(i,5)
658 naz(i,5)=xn*naz(i,5)
659 END DO
660C
661 DO i=1,jlt
662C
663 l = ishel(i)
664 IF(l==0) cycle
665C
666 IF(ix3(i)/=ix4(i))THEN
667C
668 nbx(i,1)=nod_normal(1,1,l)
669 nby(i,1)=nod_normal(2,1,l)
670 nbz(i,1)=nod_normal(3,1,l)
671C
672 nbx(i,2)=nod_normal(1,4,l)
673 nby(i,2)=nod_normal(2,4,l)
674 nbz(i,2)=nod_normal(3,4,l)
675C
676 nbx(i,3)=nod_normal(1,3,l)
677 nby(i,3)=nod_normal(2,3,l)
678 nbz(i,3)=nod_normal(3,3,l)
679C
680 nbx(i,4)=nod_normal(1,2,l)
681 nby(i,4)=nod_normal(2,2,l)
682 nbz(i,4)=nod_normal(3,2,l)
683C
684 ELSE
685C
686 nbx(i,1)=nod_normal(1,1,l)
687 nby(i,1)=nod_normal(2,1,l)
688 nbz(i,1)=nod_normal(3,1,l)
689C
690 nbx(i,2)=nod_normal(1,4,l)
691 nby(i,2)=nod_normal(2,4,l)
692 nbz(i,2)=nod_normal(3,4,l)
693C
694 nbx(i,4)=nod_normal(1,2,l)
695 nby(i,4)=nod_normal(2,2,l)
696 nbz(i,4)=nod_normal(3,2,l)
697C
698 ENDIF
699C
700 END DO
701C
702 DO i=1,jlt
703C
704 l = ishel(i)
705 IF(l==0) cycle
706C
707 IF(ix3(i)/=ix4(i))THEN
708 nbx(i,5)= fourth*(nbx(i,1)+nbx(i,2)+nbx(i,3)+nbx(i,4))
709 nby(i,5)= fourth*(nby(i,1)+nby(i,2)+nby(i,3)+nby(i,4))
710 nbz(i,5)= fourth*(nbz(i,1)+nbz(i,2)+nbz(i,3)+nbz(i,4))
711 ELSE
712 nbx(i,5)= nbx(i,4)
713 nby(i,5)= nby(i,4)
714 nbz(i,5)= nbz(i,4)
715 ENDIF
716 xn=one/max(em20,sqrt(nbx(i,5)*nbx(i,5)+nby(i,5)*nby(i,5)+nbz(i,5)*nbz(i,5)))
717 nbx(i,5)=xn*nbx(i,5)
718 nby(i,5)=xn*nby(i,5)
719 nbz(i,5)=xn*nbz(i,5)
720 END DO
721C
722 DO i=1,jlt
723 l = cand_e(i)
724 ni = cand_n(i)
725 IF(ni<=nsn)THEN
726 stif(i)=stf(l)*abs(stfn(ni))
727 ELSE
728 nn = ni - nsn
729 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
730 END IF
731 ENDDO
732C
733 ibounda(1:4,1:jlt)=0
734 DO i=1,jlt
735 l = cand_e(i)
736 DO j=1,4
737 mvoisa(i,j) =mvoisin(j,l)
738 IF(lbound(admsr(j,l))/=0)ibounda(j,i)=admsr(j,l)
739 END DO
740 END DO
741C
742 iboundb(1:4,1:jlt)=0
743 DO i=1,jlt
744 l = ishel(i)
745 IF(l==0) cycle
746
747 mvoisb(i,1)=mvoisin(1,l)
748 mvoisb(i,2)=mvoisin(4,l)
749 mvoisb(i,3)=mvoisin(3,l)
750 mvoisb(i,4)=mvoisin(2,l)
751
752 IF(lbound(admsr(2,l))/=0)iboundb(1,i)=admsr(2,l)
753 IF(lbound(admsr(1,l))/=0)iboundb(2,i)=admsr(1,l)
754 IF(lbound(admsr(4,l))/=0)iboundb(3,i)=admsr(4,l)
755 IF(lbound(admsr(3,l))/=0)iboundb(4,i)=admsr(3,l)
756 END DO
757C
758 RETURN
759 END
760!||====================================================================
761!|| i25cor3_3 ../engine/source/interfaces/int25/i25cor3.F
762!||--- called by ------------------------------------------------------
763!|| i25mainf ../engine/source/interfaces/int25/i25mainf.F
764!||--- uses -----------------------------------------------------
765!|| parameters_mod ../common_source/modules/interfaces/parameters_mod.F
766!|| tri7box ../engine/share/modules/tri7box.F
767!||====================================================================
768 SUBROUTINE i25cor3_3(
769 1 JLT ,X ,IRECT ,NSV ,CAND_E ,
770 2 CAND_N ,STF ,STFN ,STIF ,NOD_NORMAL ,
771 3 IGSTI ,KMIN ,KMAX ,MS ,MSI ,
772 3 XI ,YI ,ZI ,VXI ,VYI ,
773 4 VZI ,IX1 ,IX2 ,IX3 ,IX4 ,
774 5 NSVG ,NSN ,V ,KINET ,KINI ,
775 6 NIN ,ADMSR ,IRTLM ,SUBTRIA,
776 7 XX ,YY ,ZZ ,LBOUND ,IBOUND ,
777 8 NNX ,NNY ,NNZ ,
778 9 VX1 ,VX2 ,VX3 ,VX4 ,
779 A VY1 ,VY2 ,VY3 ,VY4 ,
780 B VZ1 ,VZ2 ,VZ3 ,VZ4 ,
781 C NODNX_SMS,NSMS ,INDEX ,PENM ,LBM ,
782 D LCM ,PENE ,LB ,LC ,
783 E GAPN_M ,GAPNM ,GAP_S ,GAPS ,IGAP ,
784 F GAP_S_L ,GAP_M_L,GAPMXL ,INTFRIC ,IPARTFRICS ,
785 G IPARTFRICSI,IPARTFRICM,IPARTFRICMI,AREAS,AREASI,
786 H IVIS2 ,MVOISIN,MVOISN ,IORTHFRIC,IREP_FRICM ,
787 I DIR_FRICM ,IREP_FRICMI,DIR_FRICMI,X1 ,Y1 ,
788 J Z1 ,X2 ,Y2 ,Z2 ,X3 ,
789 K Y3 ,Z3 ,X4 ,Y4 ,Z4 ,
790 L INTTH ,TEMP ,TEMPI ,IELES ,IELESI ,
791 M IELEM ,IELEMI,ISTIF_MSDT,DTSTIF,STIFMSDT_S ,
792 N STIFMSDT_M,NRTM ,PARAMETERS)
793C-----------------------------------------------
794C M o d u l e s
795C-----------------------------------------------
796 USE tri7box
797 USE parameters_mod
798C-----------------------------------------------
799C I m p l i c i t T y p e s
800C-----------------------------------------------
801#include "implicit_f.inc"
802C-----------------------------------------------
803C G l o b a l P a r a m e t e r s
804C-----------------------------------------------
805#include "mvsiz_p.inc"
806C-----------------------------------------------
807C C o m m o n B l o c k s
808C-----------------------------------------------
809#include "sms_c.inc"
810C-----------------------------------------------
811C D u m m y A r g u m e n t s
812C-----------------------------------------------
813 INTEGER INTTH ,JLT, NSN, NIN, IGSTI, IGAP,INTFRIC, IVIS2, IORTHFRIC
814 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*), KINET(*), KINI(*),
815 . nodnx_sms(*), index(*), admsr(4,*),
816 . lbound(*), ibound(4,*), mvoisin(4,*), mvoisn(mvsiz,4),ieles(*),
817 . ielem(*)
818 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
819 . nsvg(mvsiz), nsms(mvsiz), irtlm(4,*), subtria(mvsiz),
820 . ipartfrics(*),ipartfricsi(mvsiz),ipartfricm(*),ipartfricmi(mvsiz),
821 . irep_fricm(*),irep_fricmi(mvsiz),ielesi(mvsiz),ielemi(mvsiz)
822 INTEGER , INTENT(IN) :: ISTIF_MSDT
823 INTEGER , INTENT(IN) :: NRTM
824C REAL
825 my_real
826 . X(3,*), STF(*), STFN(*), MS(*), V(3,*),
827 . PENM(4,*), LBM(4,*), LCM(4,*),
828 . gapn_m(4,*), gap_s(*),
829 . gap_s_l(*), gap_m_l(*), gapmxl(*), areas(*),temp(*)
830C REAL
831 my_real
832 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz), kmin, kmax,
833 . xx(mvsiz,5),yy(mvsiz,5),zz(mvsiz,5),
834 . nnx(mvsiz,5), nny(mvsiz,5), nnz(mvsiz,5),
835 . vx1(mvsiz),vy1(mvsiz),vz1(mvsiz),
836 . vx2(mvsiz),vy2(mvsiz),vz2(mvsiz),
837 . vx3(mvsiz),vy3(mvsiz),vz3(mvsiz),
838 . vx4(mvsiz),vy4(mvsiz),vz4(mvsiz),
839 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz),
840 . msi(mvsiz), lb(mvsiz), lc(mvsiz), pene(mvsiz),
841 . gapnm(4,mvsiz), gaps(mvsiz),areasi(mvsiz),
842 . dir_fricm(2,*) ,dir_fricmi(mvsiz,2),
843 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
844 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
845 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
846 . tempi(mvsiz)
847 real*4 nod_normal(3,4,*)
848 my_real , INTENT(IN) :: dtstif
849 my_real , INTENT(IN) :: stifmsdt_s(nsn) ,stifmsdt_m(nrtm)
850 TYPE (PARAMETERS_) ,INTENT(INOUT):: PARAMETERS
851C-----------------------------------------------
852C L o c a l V a r i a b l e s
853C-----------------------------------------------
854 INTEGER I ,J , L, NN, IG, JFT, IX, NI, I1, I2, I3, I4, IT
855 my_real
856 . xn,dts,stif_msdt(mvsiz)
857C-----------------------------------------------
858 ibound(1:4,1:jlt)=0
859 DO i=1,jlt
860 ni = cand_n(i)
861 IF(ni<=nsn)THEN
862 ig = nsv(ni)
863 nsvg(i) = ig
864C---------------voir quand KINET(IG) est utilise
865 kini(i) = kinet(ig)
866 xi(i) = x(1,ig)
867 yi(i) = x(2,ig)
868 zi(i) = x(3,ig)
869 vxi(i) = v(1,ig)
870 vyi(i) = v(2,ig)
871 vzi(i) = v(3,ig)
872 msi(i)= ms(ig)
873 gaps(i) = gap_s(ni)
874
875 subtria(i)=mod(irtlm(2,ni),5)
876 ELSE
877 nn = ni - nsn
878 nsvg(i) = -nn
879 kini(i) = kinfi(nin)%P(nn)
880 xi(i) = xfi(nin)%P(1,nn)
881 yi(i) = xfi(nin)%P(2,nn)
882 zi(i) = xfi(nin)%P(3,nn)
883 vxi(i)= vfi(nin)%P(1,nn)
884 vyi(i)= vfi(nin)%P(2,nn)
885 vzi(i)= vfi(nin)%P(3,nn)
886 msi(i)= msfi(nin)%P(nn)
887 gaps(i) = gapfi(nin)%P(nn)
888
889 subtria(i)=mod(irtlm_fi(nin)%P(2,nn),5)
890 END IF
891C
892 IF(subtria(i) < 0)subtria(i)=-subtria(i)
893C
894 l = cand_e(i)
895C
896 ix=irect(1,l)
897 ix1(i)=ix
898 xx(i,1)=x(1,ix)
899 yy(i,1)=x(2,ix)
900 zz(i,1)=x(3,ix)
901 vx1(i)=v(1,ix)
902 vy1(i)=v(2,ix)
903 vz1(i)=v(3,ix)
904C
905 ix=irect(2,l)
906 ix2(i)=ix
907 xx(i,2)=x(1,ix)
908 yy(i,2)=x(2,ix)
909 zz(i,2)=x(3,ix)
910 vx2(i)=v(1,ix)
911 vy2(i)=v(2,ix)
912 vz2(i)=v(3,ix)
913C
914 ix=irect(3,l)
915 ix3(i)=ix
916 xx(i,3)=x(1,ix)
917 yy(i,3)=x(2,ix)
918 zz(i,3)=x(3,ix)
919 vx3(i)=v(1,ix)
920 vy3(i)=v(2,ix)
921 vz3(i)=v(3,ix)
922C
923 ix=irect(4,l)
924 ix4(i)=ix
925 xx(i,4)=x(1,ix)
926 yy(i,4)=x(2,ix)
927 zz(i,4)=x(3,ix)
928 vx4(i)=v(1,ix)
929 vy4(i)=v(2,ix)
930 vz4(i)=v(3,ix)
931C
932 IF(ix3(i) /= ix4(i))THEN
933 xx(i,5)= fourth*(xx(i,1)+xx(i,2)+xx(i,3)+xx(i,4))
934 yy(i,5)= fourth*(yy(i,1)+yy(i,2)+yy(i,3)+yy(i,4))
935 zz(i,5)= fourth*(zz(i,1)+zz(i,2)+zz(i,3)+zz(i,4))
936 ELSE
937 xx(i,5)= xx(i,3)
938 yy(i,5)= yy(i,3)
939 zz(i,5)= zz(i,3)
940 ENDIF
941C
942 gapnm(1:4,i)=gapn_m(1:4,l)
943C
944 DO j=1,4
945 mvoisn(i,j) =mvoisin(j,l)
946 IF(lbound(admsr(j,l))/=0)ibound(j,i)=admsr(j,l)
947 END DO
948C
949 END DO
950C
951 IF(igap/=3)THEN
952 gapmxl(1:jlt)=ep30
953 ELSE
954 DO i=1,jlt
955 ni = cand_n(i)
956 l = cand_e(i)
957 IF(ni<=nsn)THEN
958 gapmxl(i)=gap_s_l(ni)+gap_m_l(l)
959 ELSE
960 gapmxl(i)=gap_lfi(nin)%P(ni-nsn)+gap_m_l(l)
961 END IF
962 END DO
963 END IF
964C
965 DO i=1,jlt
966C
967 l = cand_e(i)
968C
969 nnx(i,1)=nod_normal(1,1,l)
970 nny(i,1)=nod_normal(2,1,l)
971 nnz(i,1)=nod_normal(3,1,l)
972C
973 nnx(i,2)=nod_normal(1,2,l)
974 nny(i,2)=nod_normal(2,2,l)
975 nnz(i,2)=nod_normal(3,2,l)
976C
977 nnx(i,3)=nod_normal(1,3,l)
978 nny(i,3)=nod_normal(2,3,l)
979 nnz(i,3)=nod_normal(3,3,l)
980C
981 nnx(i,4)=nod_normal(1,4,l)
982 nny(i,4)=nod_normal(2,4,l)
983 nnz(i,4)=nod_normal(3,4,l)
984C
985 END DO
986C
987 DO i=1,jlt
988 IF(ix3(i)/=ix4(i))THEN
989 nnx(i,5)=fourth*(nnx(i,1)+nnx(i,2)+nnx(i,3)+nnx(i,4))
990 nny(i,5)=fourth*(nny(i,1)+nny(i,2)+nny(i,3)+nny(i,4))
991 nnz(i,5)=fourth*(nnz(i,1)+nnz(i,2)+nnz(i,3)+nnz(i,4))
992 ELSE
993 nnx(i,5)=nnx(i,4)
994 nny(i,5)=nny(i,4)
995 nnz(i,5)=nnz(i,4)
996 ENDIF
997 xn=one/max(em20,sqrt(nnx(i,5)*nnx(i,5)+nny(i,5)*nny(i,5)+nnz(i,5)*nnz(i,5)))
998 nnx(i,5)=xn*nnx(i,5)
999 nny(i,5)=xn*nny(i,5)
1000 nnz(i,5)=xn*nnz(i,5)
1001 END DO
1002C
1003 IF(igsti<=1)THEN
1004 DO i=1,jlt
1005 l = cand_e(i)
1006 ni = cand_n(i)
1007 IF(ni<=nsn)THEN
1008 stif(i)=stf(l)*abs(stfn(ni))
1009 ELSE
1010 nn = ni - nsn
1011 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
1012 END IF
1013c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1014 ENDDO
1015 ELSEIF(igsti==2)THEN
1016 DO i=1,jlt
1017 l = cand_e(i)
1018 ni = cand_n(i)
1019 IF(ni<=nsn)THEN
1020 stif(i)=abs(stfn(ni))
1021 ELSE
1022 nn = ni - nsn
1023 stif(i)=abs(stifi(nin)%P(nn))
1024 END IF
1025 stif(i)=half*(stf(l)+stif(i))
1026c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1027 ENDDO
1028 ELSEIF(igsti==3)THEN
1029 DO i=1,jlt
1030 l = cand_e(i)
1031 ni = cand_n(i)
1032 IF(ni<=nsn)THEN
1033 stif(i)=abs(stfn(ni))
1034 ELSE
1035 nn = ni - nsn
1036 stif(i)=abs(stifi(nin)%P(nn))
1037 END IF
1038 stif(i)=max(stf(l),stif(i))
1039c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1040 ENDDO
1041 ELSEIF(igsti==4.OR.igsti==6)THEN
1042 DO i=1,jlt
1043 l = cand_e(i)
1044 ni = cand_n(i)
1045 IF(ni<=nsn)THEN
1046 stif(i)=abs(stfn(ni))
1047 ELSE
1048 nn = ni - nsn
1049 stif(i)=abs(stifi(nin)%P(nn))
1050 END IF
1051 stif(i)=min(stf(l),stif(i))
1052c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1053 ENDDO
1054 ELSEIF(igsti==5)THEN
1055 DO i=1,jlt
1056 l = cand_e(i)
1057 ni = cand_n(i)
1058 IF(ni<=nsn)THEN
1059 stif(i)=abs(stfn(ni))
1060 ELSE
1061 nn = ni - nsn
1062 stif(i)=abs(stifi(nin)%P(nn))
1063 END IF
1064 stif(i)=stf(l)*stif(i)/
1065 . max(em30,(stf(l)+stif(i)))
1066c STIF(I)=MAX(KMIN,MIN(STIF(I),KMAX))
1067 ENDDO
1068 ELSEIF(igsti==7)THEN
1069 DO i=1,jlt
1070 stif(i)=zero
1071 ENDDO
1072 ENDIF
1073
1074C------------------------------------------
1075C Stiffness based on mass and time step
1076C------------------------------------------
1077 IF(istif_msdt > 0) THEN
1078 IF(dtstif > zero) THEN
1079 dts = dtstif
1080 ELSE
1081 dts = parameters%DT_STIFINT
1082 ENDIF
1083 DO i=1,jlt
1084 l = cand_e(i)
1085 ni = cand_n(i)
1086 IF(ni<=nsn)THEN
1087 stif_msdt(i) = stifmsdt_s(ni)
1088 ELSE
1089 nn = ni - nsn
1090 stif_msdt(i) = abs(stif_msdt_fi(nin)%P(nn))
1091 ENDIF
1092 stif_msdt(i) = stifmsdt_m(l)*stif_msdt(i)/(stifmsdt_m(l)+stif_msdt(i))
1093 stif_msdt(i) = stif_msdt(i)/(dts*dts)
1094 stif(i)=max(stif(i),stif_msdt(i))
1095 ENDDO
1096 ENDIF
1097C
1098 DO i=1,jlt
1099 stif(i)=max(kmin,min(stif(i),kmax))
1100 ENDDO
1101C----------
1102 IF(idtmins==2)THEN
1103 DO i=1,jlt
1104 IF(nsvg(i)>0)THEN
1105 nsms(i)=nodnx_sms(nsvg(i))
1106 . +nodnx_sms(ix1(i))+nodnx_sms(ix2(i))
1107 . +nodnx_sms(ix3(i))+nodnx_sms(ix4(i))
1108 ELSE
1109 nn=-nsvg(i)
1110 nsms(i)=nodnxfi(nin)%P(nn)
1111 . +nodnx_sms(ix1(i))+nodnx_sms(ix2(i))
1112 . +nodnx_sms(ix3(i))+nodnx_sms(ix4(i))
1113 END IF
1114 ENDDO
1115 IF(idtmins_int/=0)THEN
1116 DO i=1,jlt
1117 IF(nsms(i)==0)nsms(i)=-1
1118 ENDDO
1119 END IF
1120 ELSEIF(idtmins_int/=0)THEN
1121 DO i=1,jlt
1122 nsms(i)=-1
1123 ENDDO
1124 ENDIF
1125C----------
1126 DO i=1,jlt
1127 it = subtria(i)
1128 pene(i)=penm(it,index(i))
1129 lb(i) =lbm(it,index(i))
1130 lc(i) =lcm(it,index(i))
1131 ENDDO
1132
1133C----Friction model : secnd part IDs---------
1134 IF(intfric > 0) THEN
1135 DO i=1,jlt
1136 ni = cand_n(i)
1137 l = cand_e(i)
1138 IF(ni<=nsn)THEN
1139 ipartfricsi(i)= ipartfrics(ni)
1140 ELSE
1141 nn = ni - nsn
1142 ipartfricsi(i)= ipartfricsfi(nin)%P(nn)
1143 END IF
1144C
1145 ipartfricmi(i) = ipartfricm(l)
1146C
1147 IF(iorthfric > 0) THEN
1148 irep_fricmi(i) =irep_fricm(l)
1149 dir_fricmi(i,1:2)=dir_fricm(1:2,l)
1150 ENDIF
1151 ENDDO
1152 ENDIF
1153
1154 DO i=1,jlt
1155 x1(i)= xx(i,1)
1156 x2(i)= xx(i,2)
1157 x3(i)= xx(i,3)
1158 x4(i)= xx(i,4)
1159 y1(i)= yy(i,1)
1160 y2(i)= yy(i,2)
1161 y3(i)= yy(i,3)
1162 y4(i)= yy(i,4)
1163 z1(i)= zz(i,1)
1164 z2(i)= zz(i,2)
1165 z3(i)= zz(i,3)
1166 z4(i)= zz(i,4)
1167 ENDDO
1168
1169C----Adhesion case - mvsize division of if_adh done in dst3_3
1170
1171 IF(intth>0.OR.ivis2==-1) THEN
1172 DO i=1,jlt
1173 ni = cand_n(i)
1174 l = cand_e(i)
1175 IF(ni<=nsn)THEN
1176 areasi(i)= areas(ni)
1177 ELSE
1178 nn = ni - nsn
1179 areasi(i)= areasfi(nin)%P(nn)
1180 END IF
1181 ENDDO
1182 ENDIF
1183
1184C----Thermal case -
1185 IF(intth>0) THEN
1186 DO i=1,jlt
1187 ni = cand_n(i)
1188 l = cand_e(i)
1189 IF(ni<=nsn)THEN
1190 ig = nsv(ni)
1191 tempi(i) = temp(ig)
1192 ielesi(i)= ieles(ni)
1193 ELSE
1194 nn = ni - nsn
1195 tempi(i) = tempfi(nin)%P(nn)
1196 ielesi(i)= matsfi(nin)%P(nn)
1197 END IF
1198 ielemi(i) = ielem(l)
1199 ENDDO
1200 ENDIF
1201C
1202 RETURN
1203 END
my_real
#define my_real
Definition cppsort.cpp:32
i25cor3_21
subroutine i25cor3_21(jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, igap, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, nsn, msegtyp, etyp, nin, gap_s, gaps, admsr, nod_normal, xx, yy, zz, nnx, nny, nnz, gap_m, gapm, gapn_m, gapnm, islide, kslide, mvoisin, mvoisn, gap_s_l, gap_m_l, gapmxl, lbound, ibound)
Definition i25cor3.F:244
i25cor3_1
subroutine i25cor3_1(jlt, x, irect, nsv, cand_e, cand_n, irtlm, stf, stfn, stif, igap, xi, yi, zi, ix1, ix2, ix3, ix4, nsvg, nsn, nin, gap_s, gaps, admsr, nod_normal, xx, yy, zz, nnx, nny, nnz, gap_m, gapm, gapn_m, gapnm, subtria, mvoisin, mvoisn, gap_s_l, gap_m_l, gapmxl, lbound, ibound)
Definition i25cor3.F:42
i25cor3_3
subroutine i25cor3_3(jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, nod_normal, igsti, kmin, kmax, ms, msi, xi, yi, zi, vxi, vyi, vzi, ix1, ix2, ix3, ix4, nsvg, nsn, v, kinet, kini, nin, admsr, irtlm, subtria, xx, yy, zz, lbound, ibound, nnx, nny, nnz, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, nodnx_sms, nsms, index, penm, lbm, lcm, pene, lb, lc, gapn_m, gapnm, gap_s, gaps, igap, gap_s_l, gap_m_l, gapmxl, intfric, ipartfrics, ipartfricsi, ipartfricm, ipartfricmi, areas, areasi, ivis2, mvoisin, mvoisn, iorthfric, irep_fricm, dir_fricm, irep_fricmi, dir_fricmi, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, intth, temp, tempi, ieles, ielesi, ielem, ielemi, istif_msdt, dtstif, stifmsdt_s, stifmsdt_m, nrtm, parameters)
Definition i25cor3.F:793
i25cor3_22
subroutine i25cor3_22(jlt, x, irect, nsv, cand_e, cand_n, stf, stfn, stif, igap, xi, yi, zi, vxi, vyi, vzi, ix1, ix2, ix3, ix4, nsvg, nsn, v, nin, gap_s, gaps, admsr, nod_normal, xx, yy, zz, vx1, vx2, vx3, vx4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, nax, nay, naz, nbx, nby, nbz, gap_m, gapm, gapn_m, gapnm, mvoisin, nrtm, msegtyp, ishel, mvoisa, mvoisb, gap_s_l, gap_m_l, gapmxl, lbound, ibounda, iboundb)
Definition i25cor3.F:473
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
parameters_mod
Definition parameters_mod.F:49
tri7box::stif_msdt_fi
type(real_pointer), dimension(:), allocatable stif_msdt_fi
Definition tri7box.F:552
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::matsfi
type(int_pointer), dimension(:), allocatable matsfi
Definition tri7box.F:440
tri7box::tempfi
type(real_pointer), dimension(:), allocatable tempfi
Definition tri7box.F:449
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::gap_lfi
type(real_pointer), dimension(:), allocatable gap_lfi
Definition tri7box.F:449
tri7box::gapfi
type(real_pointer), dimension(:), allocatable gapfi
Definition tri7box.F:449
tri7box::nodnxfi
type(int_pointer), dimension(:), allocatable nodnxfi
Definition tri7box.F:440
tri7box::areasfi
type(real_pointer), dimension(:), allocatable areasfi
Definition tri7box.F:449
tri7box::msfi
type(real_pointer), dimension(:), allocatable msfi
Definition tri7box.F:449
tri7box::ipartfricsfi
type(int_pointer), dimension(:), allocatable ipartfricsfi
Definition tri7box.F:440
tri7box::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
tri7box::kinfi
type(int_pointer), dimension(:), allocatable kinfi
Definition tri7box.F:440
tri7box::islide_fi
type(int_pointer2), dimension(:), allocatable islide_fi
Definition tri7box.F:547