OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i20cor3.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!|| i20cor3 ../engine/source/interfaces/int20/i20cor3.F
25!||--- called by ------------------------------------------------------
26!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
27!||--- uses -----------------------------------------------------
28!|| tri7box ../engine/share/modules/tri7box.F
29!||====================================================================
30 SUBROUTINE i20cor3(
31 1 JLT ,XA ,IRECT ,NSV ,CAND_E ,
32 2 CAND_N ,STF ,STFA ,X1 ,X2 ,
33 3 X3 ,X4 ,Y1 ,Y2 ,Y3 ,
34 4 Y4 ,Z1 ,Z2 ,Z3 ,Z4 ,
35 5 XI ,YI ,ZI ,STIF ,IX1 ,
36 6 IX2 ,IX3 ,IX4 ,NSVG ,IGAP ,
37 7 GAP ,GAP_S ,GAP_M ,GAPV ,GAPR ,
38 8 MS ,VXI ,VYI ,NLN ,NLG ,
39 9 VZI ,MSI ,NSN ,VA ,KINET ,
40 A KINI ,ITY ,NIN ,IGSTI ,KMIN ,
41 B KMAX ,GAPMAX,GAPMIN,IADM ,RCURV ,
42 C RCURVI ,ANGLM ,ANGLMI,INTTH ,TEMP ,
43 D TEMPI ,PHI ,AREAS ,IELEC ,AREASI ,
44 E IELECI ,GAP_SH,STFAC ,NODNX_SMS,NSMS)
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
339 END
340!||====================================================================
341!|| i20cor3e ../engine/source/interfaces/int20/i20cor3.F
342!||--- called by ------------------------------------------------------
343!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
344!||--- uses -----------------------------------------------------
345!|| tri7box ../engine/share/modules/tri7box.F
346!||====================================================================
347 SUBROUTINE i20cor3e(
348 1 JLT ,IXLINS ,IXLINM ,XA ,VA ,
349 2 CAND_S ,CAND_M ,STFS ,STFM ,GAPMIN ,
350 3 GAP_S ,GAP_M ,IGAP ,GAPV ,MS ,
351 4 STIF ,XXS1 ,XXS2 ,XYS1 ,XYS2 ,
352 5 XZS1 ,XZS2 ,XXM1 ,XXM2 ,XYM1 ,
353 6 XYM2 ,XZM1 ,XZM2 ,VXS1 ,VXS2 ,
354 7 VYS1 ,VYS2 ,VZS1 ,VZS2 ,VXM1 ,
355 8 VXM2 ,VYM1 ,VYM2 ,VZM1 ,VZM2 ,
356 9 MS1 ,MS2 ,MM1 ,MM2 ,N1 ,
357 A N2 ,M1 ,M2 ,NRTS ,NIN ,
358 B NL1 ,NL2 ,ML1 ,ML2 ,NLG ,
359 C STFAC ,NODNX_SMS,NSMS )
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
523 END
524!||====================================================================
525!|| i20dst3e ../engine/source/interfaces/int20/i20cor3.F
526!||--- called by ------------------------------------------------------
527!|| i20mainf ../engine/source/interfaces/int20/i20mainf.F
528!||====================================================================
529 SUBROUTINE i20dst3e(
530 1 JLT ,CAND_S,CAND_M,H1S ,H2S ,
531 2 H1M ,H2M ,NX ,NY ,NZ ,
532 3 STIF ,N1 ,N2 ,M1 ,M2 ,
533 4 JLT_NEW,XXS1 ,XXS2 ,XYS1 ,XYS2 ,
534 5 XZS1 ,XZS2 ,XXM1 ,XXM2 ,XYM1 ,
535 6 XYM2 ,XZM1 ,XZM2 ,VXS1 ,VXS2 ,
536 7 VYS1 ,VYS2 ,VZS1 ,VZS2 ,VXM1 ,
537 8 VXM2 ,VYM1 ,VYM2 ,VZM1 ,VZM2 ,
538 9 MS1 ,MS2 ,MM1 ,MM2 ,GAPV ,
539 A NL1 ,NL2 ,ML1 ,ML2 ,IGAP ,
540 B SOLIDN_NORMAL,GAP_S,GAP_M ,NLINSA,
541 C SOLIDN_NORMAL_FE,NSMS)
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
799 END
800C===============================================================================
my_real
#define my_real
Definition cppsort.cpp:32
i20cor3
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)
Definition i20cor3.F:45
i20cor3e
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)
Definition i20cor3.F:360
i20dst3e
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)
Definition i20cor3.F:542
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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::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::xfie
type(real_pointer2), dimension(:), allocatable xfie
Definition tri7box.F:459
tri7box::stifie
type(real_pointer), dimension(:), allocatable stifie
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::nodnxfie
type(int_pointer), dimension(:), allocatable nodnxfie
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
tri7box::msfie
type(real_pointer), dimension(:), allocatable msfie
Definition tri7box.F:449