OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20cor3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "sms_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i20cor3 (jlt, xa, irect, nsv, cand_e, cand_n, stf, stfa, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, ix1, ix2, ix3, ix4, nsvg, igap, gap, gap_s, gap_m, gapv, gapr, ms, vxi, vyi, nln, nlg, vzi, msi, nsn, va, kinet, kini, ity, nin, igsti, kmin, kmax, gapmax, gapmin, iadm, rcurv, rcurvi, anglm, anglmi, intth, temp, tempi, phi, areas, ielec, areasi, ieleci, gap_sh, stfac, nodnx_sms, nsms)
subroutine i20cor3e (jlt, ixlins, ixlinm, xa, va, cand_s, cand_m, stfs, stfm, gapmin, gap_s, gap_m, igap, gapv, ms, stif, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, vxs1, vxs2, vys1, vys2, vzs1, vzs2, vxm1, vxm2, vym1, vym2, vzm1, vzm2, ms1, ms2, mm1, mm2, n1, n2, m1, m2, nrts, nin, nl1, nl2, ml1, ml2, nlg, stfac, nodnx_sms, nsms)
subroutine i20dst3e (jlt, cand_s, cand_m, h1s, h2s, h1m, h2m, nx, ny, nz, stif, n1, n2, m1, m2, jlt_new, xxs1, xxs2, xys1, xys2, xzs1, xzs2, xxm1, xxm2, xym1, xym2, xzm1, xzm2, vxs1, vxs2, vys1, vys2, vzs1, vzs2, vxm1, vxm2, vym1, vym2, vzm1, vzm2, ms1, ms2, mm1, mm2, gapv, nl1, nl2, ml1, ml2, igap, solidn_normal, gap_s, gap_m, nlinsa, solidn_normal_fe, nsms)

Function/Subroutine Documentation

◆ i20cor3()

subroutine i20cor3 ( integer jlt,
xa,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stf,
stfa,
x1,
x2,
x3,
x4,
y1,
y2,
y3,
y4,
z1,
z2,
z3,
z4,
xi,
yi,
zi,
stif,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer, dimension(mvsiz) nsvg,
integer igap,
gap,
gap_s,
gap_m,
gapv,
gapr,
ms,
vxi,
vyi,
integer nln,
integer, dimension(*) nlg,
vzi,
msi,
integer nsn,
va,
integer, dimension(*) kinet,
integer, dimension(*) kini,
integer ity,
integer nin,
integer igsti,
kmin,
kmax,
gapmax,
gapmin,
integer iadm,
rcurv,
rcurvi,
anglm,
anglmi,
integer intth,
temp,
tempi,
phi,
areas,
integer, dimension(*) ielec,
areasi,
integer, dimension(mvsiz) ieleci,
gap_sh,
stfac,
integer, dimension(*) nodnx_sms,
integer, dimension(mvsiz) nsms )

Definition at line 30 of file i20cor3.F.

45C-----------------------------------------------
46C M o d u l e s
47C-----------------------------------------------
48 USE tri7box
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "sms_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),KINET(*),KINI(*),
65 . JLT,IDT, NOINT,IGAP ,NSN, ITY, NIN, IGSTI,
66 . IADM,INTTH, NLN, NLG(*)
67 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
68 . NSVG(MVSIZ),IELEC(*),IELECI(MVSIZ), NSMS(MVSIZ),
69 . NODNX_SMS(*)
70C REAL
71 my_real
72 . gap, xa(3,*), stf(*), stfa(*),gap_s(*),gap_m(*),
73 . ms(*), va(3,*), rcurv(*),temp(*),areas(*),phi(*),tempi(*),
74 . areasi(*), anglm(*),gap_sh(*),stfac
75C REAL
76 my_real
77 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
78 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
79 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
80 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
81 . gapv(mvsiz),gapr(mvsiz),
82 . vxi(mvsiz), vyi(mvsiz), vzi(mvsiz), msi(mvsiz),
83 . kmin, kmax, gapmax, gapmin,
84 . rcurvi(mvsiz), anglmi(mvsiz)
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER I ,J ,IL, L, NN, IG,JFT, IX, NI
89C-----------------------------------------------
90C
91 IF(igap==0)THEN
92 DO i=1,jlt
93 gapv(i)=gap
94 gapr(i)=gapv(i)
95 ENDDO
96 ELSE
97 DO i=1,jlt
98 IF(cand_n(i)<=nsn) THEN
99 gapv(i)=gap_s(cand_n(i))+gap_m(cand_e(i))
100 ELSE
101 gapv(i)=gapfi(nin)%P(cand_n(i)-nsn)+gap_m(cand_e(i))
102 ENDIF
103 gapv(i)=min(gapv(i),gapmax)
104 gapv(i)=gapv(i)+gap_sh(cand_e(i))*(one-em5)
105 gapr(i)=gapv(i)
106 gapv(i)=max(gapmin,gapv(i))
107 ENDDO
108 ENDIF
109C
110 IF(intth == 0 )THEN
111 DO i=1,jlt
112 ni = cand_n(i)
113 l = cand_e(i)
114 IF(ni<=nsn)THEN
115 il = nsv(ni)
116 ig = nlg(il)
117 nsvg(i) = ig
118 kini(i) = kinet(ig)
119
120 xi(i) = xa(1,il)
121 yi(i) = xa(2,il)
122 zi(i) = xa(3,il)
123 vxi(i) = va(1,il)
124 vyi(i) = va(2,il)
125 vzi(i) = va(3,il)
126
127 msi(i)= ms(ig)
128 ELSE
129 nn = ni - nsn
130 nsvg(i) = -nn
131 kini(i) = kinfi(nin)%P(nn)
132 xi(i) = xfi(nin)%P(1,nn)
133 yi(i) = xfi(nin)%P(2,nn)
134 zi(i) = xfi(nin)%P(3,nn)
135 vxi(i)= vfi(nin)%P(1,nn)
136 vyi(i)= vfi(nin)%P(2,nn)
137 vzi(i)= vfi(nin)%P(3,nn)
138 msi(i)= msfi(nin)%P(nn)
139 END IF
140C
141 ix=irect(1,l)
142 ix1(i)=ix
143 x1(i)=xa(1,ix)
144 y1(i)=xa(2,ix)
145 z1(i)=xa(3,ix)
146C
147 ix=irect(2,l)
148 ix2(i)=ix
149 x2(i)=xa(1,ix)
150 y2(i)=xa(2,ix)
151 z2(i)=xa(3,ix)
152C
153 ix=irect(3,l)
154 ix3(i)=ix
155 x3(i)=xa(1,ix)
156 y3(i)=xa(2,ix)
157 z3(i)=xa(3,ix)
158C
159 ix=irect(4,l)
160 ix4(i)=ix
161 x4(i)=xa(1,ix)
162 y4(i)=xa(2,ix)
163 z4(i)=xa(3,ix)
164
165 END DO
166 ELSE
167 DO i=1,jlt
168 ni = cand_n(i)
169 l = cand_e(i)
170 IF(ni<=nsn)THEN
171 il = nsv(ni)
172 ig = nlg(il)
173 nsvg(i) = ig
174 kini(i) = kinet(ig)
175
176 xi(i) = xa(1,il)
177 yi(i) = xa(2,il)
178 zi(i) = xa(3,il)
179 vxi(i) = va(1,il)
180 vyi(i) = va(2,il)
181 vzi(i) = va(3,il)
182
183 msi(i)= ms(ig)
184 tempi(i) = temp(ig)
185 areasi(i)= areas(ni)
186 ieleci(i)= ielec(ni)
187 phi(i) = zero
188 ELSE
189 nn = ni - nsn
190 nsvg(i) = -nn
191 kini(i) = kinfi(nin)%P(nn)
192 xi(i) = xfi(nin)%P(1,nn)
193 yi(i) = xfi(nin)%P(2,nn)
194 zi(i) = xfi(nin)%P(3,nn)
195 vxi(i)= vfi(nin)%P(1,nn)
196 vyi(i)= vfi(nin)%P(2,nn)
197 vzi(i)= vfi(nin)%P(3,nn)
198 msi(i)= msfi(nin)%P(nn)
199 tempi(i) = tempfi(nin)%P(nn)
200 areasi(i)= areasfi(nin)%P(nn)
201 ieleci(i)= matsfi(nin)%P(nn)
202 END IF
203
204 ix=irect(1,l)
205 ix1(i)=ix
206 x1(i)=xa(1,ix)
207 y1(i)=xa(2,ix)
208 z1(i)=xa(3,ix)
209C
210 ix=irect(2,l)
211 ix2(i)=ix
212 x2(i)=xa(1,ix)
213 y2(i)=xa(2,ix)
214 z2(i)=xa(3,ix)
215C
216 ix=irect(3,l)
217 ix3(i)=ix
218 x3(i)=xa(1,ix)
219 y3(i)=xa(2,ix)
220 z3(i)=xa(3,ix)
221C
222 ix=irect(4,l)
223 ix4(i)=ix
224 x4(i)=xa(1,ix)
225 y4(i)=xa(2,ix)
226 z4(i)=xa(3,ix)
227
228 END DO
229 ENDIF
230C
231 IF(igsti<=1)THEN
232 DO i=1,jlt
233 l = cand_e(i)
234 ni = cand_n(i)
235 IF(ni<=nsn)THEN
236 stif(i)=stf(l)*abs(stfa(nsv(ni)))
237 ELSE
238 nn = ni - nsn
239 stif(i)=stf(l)*abs(stifi(nin)%P(nn))
240 END IF
241 ENDDO
242 ELSEIF(igsti==2)THEN
243 DO i=1,jlt
244 l = cand_e(i)
245 ni = cand_n(i)
246 IF(ni<=nsn)THEN
247 stif(i)=abs(stfa(nsv(ni)))
248 ELSE
249 nn = ni - nsn
250 stif(i)=abs(stifi(nin)%P(nn))
251 END IF
252 stif(i)=half*(stf(l)+stif(i))
253 stif(i)=max(kmin,min(stif(i),kmax))
254 ENDDO
255 ELSEIF(igsti==3)THEN
256 DO i=1,jlt
257 l = cand_e(i)
258 ni = cand_n(i)
259 IF(ni<=nsn)THEN
260 stif(i)=abs(stfa(nsv(ni)))
261 ELSE
262 nn = ni - nsn
263 stif(i)=abs(stifi(nin)%P(nn))
264 END IF
265 stif(i)=max(stf(l),stif(i))
266 stif(i)=max(kmin,min(stif(i),kmax))
267 ENDDO
268 ELSEIF(igsti==4)THEN
269 DO i=1,jlt
270 l = cand_e(i)
271 ni = cand_n(i)
272 IF(ni<=nsn)THEN
273 stif(i)=abs(stfa(nsv(ni)))
274 ELSE
275 nn = ni - nsn
276 stif(i)=abs(stifi(nin)%P(nn))
277 END IF
278 stif(i)=min(stf(l),stif(i))
279 stif(i)=max(kmin,min(stif(i),kmax))
280 ENDDO
281 ELSEIF(igsti==5)THEN
282 DO i=1,jlt
283 l = cand_e(i)
284 ni = cand_n(i)
285 IF(ni<=nsn)THEN
286 stif(i)=abs(stfa(nsv(ni)))
287 ELSE
288 nn = ni - nsn
289 stif(i)=abs(stifi(nin)%P(nn))
290 END IF
291 stif(i)=stf(l)*stif(i)/
292 . max(em30,(stf(l)+stif(i)))
293 stif(i)=max(kmin,min(stif(i),kmax))
294 ENDDO
295 ENDIF
296
297 DO i=1,jlt
298 stif(i)=max(stfac,one)*stif(i)
299 ENDDO
300
301 IF(iadm/=0)THEN
302 DO i=1,jlt
303 l = cand_e(i)
304 rcurvi(i)=rcurv(l)
305 anglmi(i)=anglm(l)
306 END DO
307 END IF
308
309C
310 IF(idtmins==2)THEN
311 DO i=1,jlt
312 IF(nsvg(i)>0)THEN
313 nsms(i)=nodnx_sms(nsvg(i))
314 . +nodnx_sms(nlg(ix1(i)))
315 . +nodnx_sms(nlg(ix2(i)))
316 . +nodnx_sms(nlg(ix3(i)))
317 . +nodnx_sms(nlg(ix4(i)))
318 ELSE
319 nn=-nsvg(i)
320 nsms(i)=nodnxfi(nin)%P(nn)
321 . +nodnx_sms(nlg(ix1(i)))
322 . +nodnx_sms(nlg(ix2(i)))
323 . +nodnx_sms(nlg(ix3(i)))
324 . +nodnx_sms(nlg(ix4(i)))
325 END IF
326 ENDDO
327 IF(idtmins_int/=0)THEN
328 DO i=1,jlt
329 IF(nsms(i)==0)nsms(i)=-1
330 ENDDO
331 END IF
332 ELSEIF(idtmins_int/=0)THEN
333 DO i=1,jlt
334 nsms(i)=-1
335 ENDDO
336 ENDIF
337
338 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
tri7box::vfi
type(real_pointer2), dimension(:), allocatable vfi
Definition tri7box.F:459
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::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::xfi
type(real_pointer2), dimension(:), allocatable xfi
Definition tri7box.F:459
tri7box::kinfi
type(int_pointer), dimension(:), allocatable kinfi
Definition tri7box.F:440

◆ i20cor3e()

subroutine i20cor3e ( integer jlt,
integer, dimension(2,*) ixlins,
integer, dimension(2,*) ixlinm,
xa,
va,
integer, dimension(*) cand_s,
integer, dimension(*) cand_m,
stfs,
stfm,
gapmin,
gap_s,
gap_m,
integer igap,
gapv,
ms,
stif,
xxs1,
xxs2,
xys1,
xys2,
xzs1,
xzs2,
xxm1,
xxm2,
xym1,
xym2,
xzm1,
xzm2,
vxs1,
vxs2,
vys1,
vys2,
vzs1,
vzs2,
vxm1,
vxm2,
vym1,
vym2,
vzm1,
vzm2,
ms1,
ms2,
mm1,
mm2,
integer, dimension(mvsiz) n1,
integer, dimension(mvsiz) n2,
integer, dimension(mvsiz) m1,
integer, dimension(mvsiz) m2,
integer nrts,
integer nin,
integer, dimension(mvsiz) nl1,
integer, dimension(mvsiz) nl2,
integer, dimension(mvsiz) ml1,
integer, dimension(mvsiz) ml2,
integer, dimension(*) nlg,
stfac,
integer, dimension(*) nodnx_sms,
integer, dimension(mvsiz) nsms )

Definition at line 347 of file i20cor3.F.

360C-----------------------------------------------
361C M o d u l e s
362C-----------------------------------------------
363 USE tri7box
364C-----------------------------------------------
365C I m p l i c i t T y p e s
366C-----------------------------------------------
367#include "implicit_f.inc"
368C-----------------------------------------------
369C G l o b a l P a r a m e t e r s
370C-----------------------------------------------
371#include "mvsiz_p.inc"
372C-----------------------------------------------
373C C o m m o n B l o c k s
374C-----------------------------------------------
375#include "sms_c.inc"
376C-----------------------------------------------
377C D u m m y A r g u m e n t s
378C-----------------------------------------------
379 INTEGER IXLINS(2,*), IXLINM(2,*), CAND_M(*), CAND_S(*),
380 . JLT, IGAP , NRTS, NIN,
381 . N1(MVSIZ), N2(MVSIZ), NL1(MVSIZ), NL2(MVSIZ),
382 . M1(MVSIZ), M2(MVSIZ), ML1(MVSIZ), ML2(MVSIZ),NLG(*),
383 . NODNX_SMS(*), NSMS(MVSIZ)
384C REAL
385 my_real
386 . gapmin, xa(3,*), stfm(*), stfs(*),gap_s(*),gap_m(*),
387 . ms(*), va(3,*),
388 . xxs1(mvsiz), xxs2(mvsiz), xys1(mvsiz), xys2(mvsiz),
389 . xzs1(mvsiz), xzs2(mvsiz), xxm1(mvsiz), xxm2(mvsiz),
390 . xym1(mvsiz), xym2(mvsiz), xzm1(mvsiz), xzm2(mvsiz),
391 . vxs1(mvsiz), vxs2(mvsiz), vys1(mvsiz), vys2(mvsiz),
392 . vzs1(mvsiz), vzs2(mvsiz), vxm1(mvsiz), vxm2(mvsiz),
393 . vym1(mvsiz), vym2(mvsiz), vzm1(mvsiz), vzm2(mvsiz),
394 . ms1(mvsiz), ms2(mvsiz), mm1(mvsiz), mm2(mvsiz),
395 . gapv(mvsiz), stif(mvsiz),stfac
396C-----------------------------------------------
397C L o c a l V a r i a b l e s
398C-----------------------------------------------
399 INTEGER I ,NN
400C-----------------------------------------------
401 IF(igap==0)THEN
402 DO i=1,jlt
403 gapv(i)=gapmin
404 ENDDO
405 ELSE
406 DO i=1,jlt
407 IF(cand_s(i)<=nrts) THEN
408 gapv(i)=gap_s(cand_s(i))+gap_m(cand_m(i))
409 ELSE
410 gapv(i)=gapfie(nin)%P(cand_s(i)-nrts)+gap_m(cand_m(i))
411 ENDIF
412 gapv(i)=max(gapmin,gapv(i))
413 ENDDO
414 ENDIF
415C
416 DO i=1,jlt
417 IF(cand_s(i)<=nrts) THEN
418 nl1(i)=ixlins(1,cand_s(i))
419 nl2(i)=ixlins(2,cand_s(i))
420 ml1(i)=ixlinm(1,cand_m(i))
421 ml2(i)=ixlinm(2,cand_m(i))
422 n1(i)=nlg(nl1(i))
423 n2(i)=nlg(nl2(i))
424 m1(i)=nlg(ml1(i))
425 m2(i)=nlg(ml2(i))
426 stif(i)=abs(stfs(cand_s(i)))*stfm(cand_m(i))
427 . / max(em20,abs(stfs(cand_s(i)))+stfm(cand_m(i)))
428 xxs1(i) = xa(1,nl1(i))
429 xys1(i) = xa(2,nl1(i))
430 xzs1(i) = xa(3,nl1(i))
431 xxs2(i) = xa(1,nl2(i))
432 xys2(i) = xa(2,nl2(i))
433 xzs2(i) = xa(3,nl2(i))
434 xxm1(i) = xa(1,ml1(i))
435 xym1(i) = xa(2,ml1(i))
436 xzm1(i) = xa(3,ml1(i))
437 xxm2(i) = xa(1,ml2(i))
438 xym2(i) = xa(2,ml2(i))
439 xzm2(i) = xa(3,ml2(i))
440 vxs1(i) = va(1,nl1(i))
441 vys1(i) = va(2,nl1(i))
442 vzs1(i) = va(3,nl1(i))
443 vxs2(i) = va(1,nl2(i))
444 vys2(i) = va(2,nl2(i))
445 vzs2(i) = va(3,nl2(i))
446 vxm1(i) = va(1,ml1(i))
447 vym1(i) = va(2,ml1(i))
448 vzm1(i) = va(3,ml1(i))
449 vxm2(i) = va(1,ml2(i))
450 vym2(i) = va(2,ml2(i))
451 vzm2(i) = va(3,ml2(i))
452 ms1(i) = ms(n1(i))
453 ms2(i) = ms(n2(i))
454 mm1(i) = ms(m1(i))
455 mm2(i) = ms(m2(i))
456 ELSE
457 nn = cand_s(i) - nrts
458 n1(i)=2*(nn-1)+1
459 n2(i)=2*nn
460 ml1(i)=ixlinm(1,cand_m(i))
461 ml2(i)=ixlinm(2,cand_m(i))
462 m1(i) =nlg(ml1(i))
463 m2(i) =nlg(ml2(i))
464 stif(i)=abs(stifie(nin)%P(nn))*stfm(cand_m(i))
465 . / max(em20,abs(stifie(nin)%P(nn))+stfm(cand_m(i)))
466 xxs1(i) = xfie(nin)%P(1,n1(i))
467 xys1(i) = xfie(nin)%P(2,n1(i))
468 xzs1(i) = xfie(nin)%P(3,n1(i))
469 xxs2(i) = xfie(nin)%P(1,n2(i))
470 xys2(i) = xfie(nin)%P(2,n2(i))
471 xzs2(i) = xfie(nin)%P(3,n2(i))
472 xxm1(i) = xa(1,ml1(i))
473 xym1(i) = xa(2,ml1(i))
474 xzm1(i) = xa(3,ml1(i))
475 xxm2(i) = xa(1,ml2(i))
476 xym2(i) = xa(2,ml2(i))
477 xzm2(i) = xa(3,ml2(i))
478 vxs1(i) = vfie(nin)%P(1,n1(i))
479 vys1(i) = vfie(nin)%P(2,n1(i))
480 vzs1(i) = vfie(nin)%P(3,n1(i))
481 vxs2(i) = vfie(nin)%P(1,n2(i))
482 vys2(i) = vfie(nin)%P(2,n2(i))
483 vzs2(i) = vfie(nin)%P(3,n2(i))
484 vxm1(i) = va(1,ml1(i))
485 vym1(i) = va(2,ml1(i))
486 vzm1(i) = va(3,ml1(i))
487 vxm2(i) = va(1,ml2(i))
488 vym2(i) = va(2,ml2(i))
489 vzm2(i) = va(3,ml2(i))
490 ms1(i) = msfie(nin)%P(n1(i))
491 ms2(i) = msfie(nin)%P(n2(i))
492 mm1(i) = ms(m1(i))
493 mm2(i) = ms(m2(i))
494 END IF
495 END DO
496
497 DO i=1,jlt
498 stif(i)=max(stfac,one)*stif(i)
499 ENDDO
500C
501 IF(idtmins==2)THEN
502 DO i=1,jlt
503 IF(cand_s(i)<=nrts)THEN
504 nsms(i)=nodnx_sms(n1(i))+nodnx_sms(n2(i))+
505 . nodnx_sms(m1(i))+nodnx_sms(m2(i))
506 ELSE
507 nsms(i)=nodnxfie(nin)%P(n1(i))+nodnxfie(nin)%P(n2(i))+
508 . nodnx_sms(m1(i))+nodnx_sms(m2(i))
509 END IF
510 ENDDO
511 IF(idtmins_int/=0)THEN
512 DO i=1,jlt
513 IF(nsms(i)==0)nsms(i)=-1
514 ENDDO
515 END IF
516 ELSEIF(idtmins_int/=0)THEN
517 DO i=1,jlt
518 nsms(i)=-1
519 ENDDO
520 ENDIF
521C
522 RETURN
tri7box::gapfie
type(real_pointer), dimension(:), allocatable gapfie
Definition tri7box.F:449
tri7box::vfie
type(real_pointer2), dimension(:), allocatable vfie
Definition tri7box.F:459
tri7box::xfie
type(real_pointer2), dimension(:), allocatable xfie
Definition tri7box.F:459
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
Definition tri7box.F:449
tri7box::nodnxfie
type(int_pointer), dimension(:), allocatable nodnxfie
Definition tri7box.F:440
tri7box::msfie
type(real_pointer), dimension(:), allocatable msfie
Definition tri7box.F:449

◆ i20dst3e()

subroutine i20dst3e ( integer jlt,
integer, dimension(mvsiz) cand_s,
integer, dimension(mvsiz) cand_m,
h1s,
h2s,
h1m,
h2m,
nx,
ny,
nz,
stif,
integer, dimension(mvsiz) n1,
integer, dimension(mvsiz) n2,
integer, dimension(mvsiz) m1,
integer, dimension(mvsiz) m2,
integer jlt_new,
xxs1,
xxs2,
xys1,
xys2,
xzs1,
xzs2,
xxm1,
xxm2,
xym1,
xym2,
xzm1,
xzm2,
vxs1,
vxs2,
vys1,
vys2,
vzs1,
vzs2,
vxm1,
vxm2,
vym1,
vym2,
vzm1,
vzm2,
ms1,
ms2,
mm1,
mm2,
gapv,
integer, dimension(mvsiz) nl1,
integer, dimension(mvsiz) nl2,
integer, dimension(mvsiz) ml1,
integer, dimension(mvsiz) ml2,
integer igap,
integer, dimension(3,*) solidn_normal,
gap_s,
gap_m,
integer nlinsa,
integer, dimension(3,*) solidn_normal_fe,
integer, dimension(mvsiz) nsms )

Definition at line 529 of file i20cor3.F.

542C-----------------------------------------------
543C I m p l i c i t T y p e s
544C-----------------------------------------------
545#include "implicit_f.inc"
546C-----------------------------------------------
547C G l o b a l P a r a m e t e r s
548C-----------------------------------------------
549#include "mvsiz_p.inc"
550#include "sms_c.inc"
551C-----------------------------------------------
552C D u m m y A r g u m e n t s
553C-----------------------------------------------
554 INTEGER JLT,JLT_NEW,IGAP,NLINSA
555 INTEGER CAND_S(MVSIZ),CAND_M(MVSIZ),
556 . N1(MVSIZ),N2(MVSIZ),M1(MVSIZ),M2(MVSIZ),
557 . NL1(MVSIZ), NL2(MVSIZ),ML1(MVSIZ), ML2(MVSIZ),
558 . NSMS(MVSIZ)
559 INTEGER SOLIDN_NORMAL(3,*), SOLIDN_NORMAL_FE(3,*)
560 my_real
561 . h1s(*),h2s(*),h1m(*),h2m(*),nx(*),ny(*),nz(*),stif(*),
562 . xxs1(*) ,xxs2(*) ,xys1(*) ,xys2(*) ,
563 . xzs1(*) ,xzs2(*) ,xxm1(*) ,xxm2(*) ,xym1(*),
564 . xym2(*) ,xzm1(*) ,xzm2(*) ,vxs1(*) ,vxs2(*),
565 . vys1(*) ,vys2(*) ,vzs1(*) ,vzs2(*) ,vxm1(*),
566 . vxm2(*) ,vym1(*) ,vym2(*) ,vzm1(*) ,vzm2(*),
567 . ms1(*) ,ms2(*) ,mm1(*) ,mm2(*), gapv(*),
568 . gap_s(*),gap_m(*)
569C-----------------------------------------------
570C L o c a l V a r i a b l e s
571C-----------------------------------------------
572 INTEGER I
573 my_real
574 . pene2(mvsiz),
575 . xs12,ys12,zs12,xm12,ym12,zm12,xa,xb,
576 . xs2,xm2,xsm,xs2m2,ys2,ym2,ysm,ys2m2,zs2,zm2,zsm,zs2m2,
577 . xx,yy,zz,als,alm,det,aaa,gap2,
578 . sx1,sx2,sx3,sx4,sy1,sy2,sy3,sy4,sz1,sz2,sz3,sz4
579C-----------------------------------------------
580 jlt_new = 0
581C--------------------------------------------------------
582C
583C--------------------------------------------------------
584C F = [A*X1+(1-A)*X2-B*X3-(1-B)*X4]^2 + [..Y..]^2 + [..Z..]^2
585C DF/DA = 0 = (X1-X2)(A(X1-X2)+X2-X4 +B(X4-X3))+...
586C DF/DA = 0 = A(X1-X2)^2 +X2-X4 + B(X1-X2)(X4-X3))+...
587C DF/DA = 0 = A[(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
588C + B[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
589C + (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
590C DF/DB = 0 = (X4-X3)(A(X1-X2)+X2-X4 +B(X4-X3))+...
591C DF/DB = 0 = B[(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
592C + A[(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
593C + (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
594C XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
595C XM2 = [(X4-X3)^2 + (Y4-Y3)^2 + (Z4-Z3)^2]
596C XSM = [(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
597C XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
598C XB = (X4-X3)(X2-X4) + (Y4-Y3)(Y2-Y4) + (Z4-Z3)(Z2-Z4)
599C A XS2 + B XSM + XA = 0
600C A XSM + B XM2 + XB = 0
601C
602C A = -(XA + B XSM)/XS2
603C -(XA + B XSM)*XSM + B XM2*XS2 + XB*XS2 = 0
604C -B XSM*XSM + B XM2*XS2 + XB*XS2-XA*XSM = 0
605C B*(XM2*XS2 - XSM*XSM) = -XB*XS2+XA*XSM
606C B = (XA*XSM-XB*XS2) / (XM2*XS2 - XSM*XSM)
607C A = (XB*XSM-XA*XM2) / (XM2*XS2 - XSM*XSM)
608C
609C IF B<0 => B=0
610C
611C XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
612C XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
613C A = - XA /XS2
614C B = 0
615C
616C ELSEIF B>1 => B=1
617C
618C B = 1
619C XS2 = [(X1-X2)^2 + (Y1-Y2)^2 + (Z1-Z2)^2]
620C XSM = [(X1-X2)(X4-X3) + (Y1-Y2)(Y4-Y3) + (Z1-Z2)(Z4-Z3)]
621C XA = (X1-X2)(X2-X4) + (Y1-Y2)(Y2-Y4) + (Z1-Z2)(Z2-Z4)
622C A = -(XA + XSM)/XS2
623C
624C IF A<0 => A=0
625C
626C
627C ELSEIF A>1 => A=1
628C
629C
630 DO i=1,jlt
631 IF(igap/=0)THEN
632 aaa = gap_s(cand_s(i))
633 IF(cand_s(i)<=nlinsa) THEN
634 sx1 = solidn_normal(1,n1(i))*aaa
635 sy1 = solidn_normal(2,n1(i))*aaa
636 sz1 = solidn_normal(3,n1(i))*aaa
637 sx2 = solidn_normal(1,n2(i))*aaa
638 sy2 = solidn_normal(2,n2(i))*aaa
639 sz2 = solidn_normal(3,n2(i))*aaa
640 ELSE
641C noeuds remote en SPMD
642 sx1 = solidn_normal_fe(1,n1(i))*aaa
643 sy1 = solidn_normal_fe(2,n1(i))*aaa
644 sz1 = solidn_normal_fe(3,n1(i))*aaa
645 sx2 = solidn_normal_fe(1,n2(i))*aaa
646 sy2 = solidn_normal_fe(2,n2(i))*aaa
647 sz2 = solidn_normal_fe(3,n2(i))*aaa
648 END IF
649 aaa = gap_m(cand_m(i))
650 sx3 = solidn_normal(1,m1(i))*aaa
651 sy3 = solidn_normal(2,m1(i))*aaa
652 sz3 = solidn_normal(3,m1(i))*aaa
653 sx4 = solidn_normal(1,m2(i))*aaa
654 sy4 = solidn_normal(2,m2(i))*aaa
655 sz4 = solidn_normal(3,m2(i))*aaa
656 xxs1(i) = xxs1(i) - sx1
657 xys1(i) = xys1(i) - sy1
658 xzs1(i) = xzs1(i) - sz1
659 xxs2(i) = xxs2(i) - sx2
660 xys2(i) = xys2(i) - sy2
661 xzs2(i) = xzs2(i) - sz2
662 xxm1(i) = xxm1(i) - sx3
663 xym1(i) = xym1(i) - sy3
664 xzm1(i) = xzm1(i) - sz3
665 xxm2(i) = xxm2(i) - sx4
666 xym2(i) = xym2(i) - sy4
667 xzm2(i) = xzm2(i) - sz4
668 ENDIF
669 xs12 = xxs2(i)-xxs1(i)
670 ys12 = xys2(i)-xys1(i)
671 zs12 = xzs2(i)-xzs1(i)
672 xs2 = xs12*xs12 + ys12*ys12 + zs12*zs12
673 xm12 = xxm2(i)-xxm1(i)
674 ym12 = xym2(i)-xym1(i)
675 zm12 = xzm2(i)-xzm1(i)
676 xm2 = xm12*xm12 + ym12*ym12 + zm12*zm12
677 xsm = - (xs12*xm12 + ys12*ym12 + zs12*zm12)
678 xs2m2 = xxm2(i)-xxs2(i)
679 ys2m2 = xym2(i)-xys2(i)
680 zs2m2 = xzm2(i)-xzs2(i)
681
682 xa = xs12*xs2m2 + ys12*ys2m2 + zs12*zs2m2
683 xb = -xm12*xs2m2 - ym12*ys2m2 - zm12*zs2m2
684 det = xm2*xs2 - xsm*xsm
685 det = max(em20,det)
686C
687 h1m(i) = (xa*xsm-xb*xs2) / det
688C
689 xs2 = max(xs2,em20)
690 xm2 = max(xm2,em20)
691 h1m(i)=min(one,max(zero,h1m(i)))
692 h1s(i) = -(xa + h1m(i)*xsm) / xs2
693 h1s(i)=min(one,max(zero,h1s(i)))
694 h1m(i) = -(xb + h1s(i)*xsm) / xm2
695 h1m(i)=min(one,max(zero,h1m(i)))
696
697 h2s(i) = one -h1s(i)
698 h2m(i) = one -h1m(i)
699C !!!!!!!!!!!!!!!!!!!!!!!
700C PENE = GAP^2 - DIST^2 UTILISE POUR TESTER SI NON NUL
701C!!!!!!!!!!!!!!!!!!!!!!!!
702 nx(i) = h1s(i)*xxs1(i) + h2s(i)*xxs2(i)
703 . - h1m(i)*xxm1(i) - h2m(i)*xxm2(i)
704 ny(i) = h1s(i)*xys1(i) + h2s(i)*xys2(i)
705 . - h1m(i)*xym1(i) - h2m(i)*xym2(i)
706 nz(i) = h1s(i)*xzs1(i) + h2s(i)*xzs2(i)
707 . - h1m(i)*xzm1(i) - h2m(i)*xzm2(i)
708 gap2 = gapv(i)*gapv(i)
709 pene2(i) = gap2 - nx(i)*nx(i) - ny(i)*ny(i) - nz(i)*nz(i)
710 pene2(i) = max(zero,pene2(i))
711
712 ENDDO
713 IF(idtmins/=2)THEN
714 DO i=1,jlt
715 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
716 jlt_new = jlt_new + 1
717 cand_s(jlt_new) = cand_s(i)
718 cand_m(jlt_new) = cand_m(i)
719 nl1(jlt_new) = nl1(i)
720 nl2(jlt_new) = nl2(i)
721 ml1(jlt_new) = ml1(i)
722 ml2(jlt_new) = ml2(i)
723 n1(jlt_new) = n1(i)
724 n2(jlt_new) = n2(i)
725 m1(jlt_new) = m1(i)
726 m2(jlt_new) = m2(i)
727 h1s(jlt_new) = h1s(i)
728 h2s(jlt_new) = h2s(i)
729 h1m(jlt_new) = h1m(i)
730 h2m(jlt_new) = h2m(i)
731 nx(jlt_new) = nx(i)
732 ny(jlt_new) = ny(i)
733 nz(jlt_new) = nz(i)
734 stif(jlt_new) = stif(i)
735 gapv(jlt_new) = gapv(i)
736 vxs1(jlt_new) = vxs1(i)
737 vys1(jlt_new) = vys1(i)
738 vzs1(jlt_new) = vzs1(i)
739 vxs2(jlt_new) = vxs2(i)
740 vys2(jlt_new) = vys2(i)
741 vzs2(jlt_new) = vzs2(i)
742 vxm1(jlt_new) = vxm1(i)
743 vym1(jlt_new) = vym1(i)
744 vzm1(jlt_new) = vzm1(i)
745 vxm2(jlt_new) = vxm2(i)
746 vym2(jlt_new) = vym2(i)
747 vzm2(jlt_new) = vzm2(i)
748 ms1(jlt_new) = ms1(i)
749 ms2(jlt_new) = ms2(i)
750 mm1(jlt_new) = mm1(i)
751 mm2(jlt_new) = mm2(i)
752 ENDIF
753 ENDDO
754 ELSE
755 DO i=1,jlt
756 IF(pene2(i)/=zero.AND.stif(i)/=zero)THEN
757 jlt_new = jlt_new + 1
758 cand_s(jlt_new) = cand_s(i)
759 cand_m(jlt_new) = cand_m(i)
760 nl1(jlt_new) = nl1(i)
761 nl2(jlt_new) = nl2(i)
762 ml1(jlt_new) = ml1(i)
763 ml2(jlt_new) = ml2(i)
764 n1(jlt_new) = n1(i)
765 n2(jlt_new) = n2(i)
766 m1(jlt_new) = m1(i)
767 m2(jlt_new) = m2(i)
768 h1s(jlt_new) = h1s(i)
769 h2s(jlt_new) = h2s(i)
770 h1m(jlt_new) = h1m(i)
771 h2m(jlt_new) = h2m(i)
772 nx(jlt_new) = nx(i)
773 ny(jlt_new) = ny(i)
774 nz(jlt_new) = nz(i)
775 stif(jlt_new) = stif(i)
776 gapv(jlt_new) = gapv(i)
777 vxs1(jlt_new) = vxs1(i)
778 vys1(jlt_new) = vys1(i)
779 vzs1(jlt_new) = vzs1(i)
780 vxs2(jlt_new) = vxs2(i)
781 vys2(jlt_new) = vys2(i)
782 vzs2(jlt_new) = vzs2(i)
783 vxm1(jlt_new) = vxm1(i)
784 vym1(jlt_new) = vym1(i)
785 vzm1(jlt_new) = vzm1(i)
786 vxm2(jlt_new) = vxm2(i)
787 vym2(jlt_new) = vym2(i)
788 vzm2(jlt_new) = vzm2(i)
789 ms1(jlt_new) = ms1(i)
790 ms2(jlt_new) = ms2(i)
791 mm1(jlt_new) = mm1(i)
792 mm2(jlt_new) = mm2(i)
793 nsms(jlt_new)= nsms(i)
794 ENDIF
795 ENDDO
796 END IF
797C
798 RETURN